units/service/service_demo/MainControlKOLService.pas

   1 { KOL MCK } // Do not remove this line!
   2 {$DEFINE KOL_MCK}
   3 unit MainControlKOLService;
   4
   5 interface
   6
   7 {$IFDEF KOL_MCK}
   8 uses Windows, Messages, ShellAPI, KOL {$IFNDEF KOL_MCK}, mirror, Controls, mckObjs, mckCtrls, Classes {$ENDIF},
   9      Service;
  10 {$ELSE}
  11 {$I uses.inc} mirror,
  12   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  13   mirror;
  14 {$ENDIF}
  15
  16 type
  17   {$IFDEF KOL_MCK}
  18   {$I MCKfakeClasses.inc}
  19   PForm1 = ^TForm1;
  20   TForm1 = object(TObj)
  21     Form: PControl;
  22   {$ELSE not_KOL_MCK}
  23   TForm1 = class(TForm)
  24   {$ENDIF KOL_MCK}
  25     KOLProject1: TKOLProject;
  26     fmControlKOLService: TKOLForm;
  27     Label1: TKOLLabel;
  28     btnInstall: TKOLButton;
  29     btnStart: TKOLButton;
  30     btnStop: TKOLButton;
  31     btnPause: TKOLButton;
  32     btnResume: TKOLButton;
  33     btnRemove: TKOLButton;
  34     Label2: TKOLLabel;
  35     Timer1: TKOLTimer;
  36     Label3: TKOLLabel;
  37     Button1: TKOLButton;
  38     Button2: TKOLButton;
  39     Button3: TKOLButton;
  40     Button4: TKOLButton;
  41     Button5: TKOLButton;
  42     Button6: TKOLButton;
  43     Label4: TKOLLabel;
  44     procedure btnInstallClick(Sender: PObj);
  45     procedure Button1Click(Sender: PObj);
  46     procedure btnStartClick(Sender: PObj);
  47     procedure Button2Click(Sender: PObj);
  48     procedure btnStopClick(Sender: PObj);
  49     procedure Button3Click(Sender: PObj);
  50     procedure btnPauseClick(Sender: PObj);
  51     procedure Button4Click(Sender: PObj);
  52     procedure btnResumeClick(Sender: PObj);
  53     procedure Button5Click(Sender: PObj);
  54     procedure btnRemoveClick(Sender: PObj);
  55     procedure Button6Click(Sender: PObj);
  56     procedure fmControlKOLServiceFormCreate(Sender: PObj);
  57     function fmControlKOLServiceMessage(var Msg: tagMSG;
  58       var Rslt: Integer): Boolean;
  59     procedure Timer1Timer(Sender: PObj);
  60   private
  61     { Private declarations }
  62     procedure RefreshStatus;
  63     procedure DoRefreshStatus;
  64     function BadHandles( SrvCtl: PServiceCtl ): Boolean;
  65   public
  66     { Public declarations }
  67   end;
  68
  69 var
  70   Form1 {$IFDEF KOL_MCK} : PForm1 {$ELSE} : TForm1 {$ENDIF} ;
  71
  72 {$IFDEF KOL_MCK}
  73 procedure NewForm1( var Result: PForm1; AParent: PControl );
  74 {$ENDIF}
  75
  76 implementation
  77
  78 {$IFNDEF KOL_MCK} {$R *.DFM} {$ENDIF}
  79
  80 {$IFDEF KOL_MCK}
  81 {$I MainControlKOLService_1.inc}
  82 {$ENDIF}
  83
  84 procedure TForm1.DoRefreshStatus;
  85 var SrvCtl: PServiceCtl;
  86     E_Inst, E_Remv, E_Strt, E_Stop, E_Paus, E_Resm: Boolean;
  87 begin
  88   E_Inst := FALSE;
  89   E_Remv := FALSE;
  90   E_Strt := FALSE;
  91   E_Stop := FALSE;
  92   E_Paus := FALSE;
  93   E_Resm := FALSE;
  94   SrvCtl := OpenServiceCtl( '', '', 'KOL_ServiceA', SERVICE_QUERY_STATUS );
  95   if SrvCtl.Handle = 0 then
  96   begin
  97     Label1.Caption := 'Not installed';
  98     E_Inst := TRUE;
  99   end
 100     else
 101   case SrvCtl.Status.dwCurrentState of
 102   SERVICE_STOPPED:         begin
 103                              Label1.Caption := 'Stopped';
 104                              E_Strt := TRUE;
 105                              E_Remv := TRUE;
 106                            end;
 107   SERVICE_START_PENDING:   begin
 108                              Label1.Caption := 'Starting...';
 109                              E_Stop := TRUE;
 110                              E_Remv := TRUE;
 111                            end;
 112   SERVICE_STOP_PENDING:    begin
 113                              Label1.Caption := 'Stopping...';
 114                              E_Remv := TRUE;
 115                            end;
 116   SERVICE_RUNNING:         begin
 117                              Label1.Caption := 'RUNNING';
 118                              E_Stop := TRUE;
 119                              E_Paus := TRUE;
 120                              E_Remv := TRUE;
 121                            end;
 122   SERVICE_CONTINUE_PENDING:begin
 123                              Label1.Caption := 'Resuming...';
 124                              E_Stop := TRUE;
 125                              E_Remv := TRUE;
 126                            end;
 127   SERVICE_PAUSE_PENDING:   begin
 128                              Label1.Caption := 'Pausing...';
 129                              E_Remv := TRUE;
 130                            end;
 131   SERVICE_PAUSED:          begin
 132                              Label1.Caption := 'Paused';
 133                              E_Resm := TRUE;
 134                              E_Stop := TRUE;
 135                              E_Remv := TRUE;
 136                            end;
 137   end;
 138   btnInstall.Enabled := E_Inst;
 139   btnRemove .Enabled := E_Remv;
 140   btnStart  .Enabled := E_Strt;
 141   btnStop   .Enabled := E_Stop;
 142   btnPause  .Enabled := E_Paus;
 143   btnResume .Enabled := E_Resm;
 144   SrvCtl.Free;
 145
 146   E_Inst := FALSE;
 147   E_Remv := FALSE;
 148   E_Strt := FALSE;
 149   E_Stop := FALSE;
 150   E_Paus := FALSE;
 151   E_Resm := FALSE;
 152   SrvCtl := OpenServiceCtl( '', '', 'KOL_ServiceB', SERVICE_QUERY_STATUS );
 153   if SrvCtl.Handle = 0 then
 154   begin
 155     Label3.Caption := 'Not installed';
 156     E_Inst := TRUE;
 157   end
 158     else
 159   case SrvCtl.Status.dwCurrentState of
 160   SERVICE_STOPPED:         begin
 161                              Label3.Caption := 'Stopped';
 162                              E_Strt := TRUE;
 163                              E_Remv := TRUE;
 164                            end;
 165   SERVICE_START_PENDING:   begin
 166                              Label3.Caption := 'Starting...';
 167                              E_Stop := TRUE;
 168                              E_Remv := TRUE;
 169                            end;
 170   SERVICE_STOP_PENDING:    begin
 171                              Label3.Caption := 'Stopping...';
 172                              E_Remv := TRUE;
 173                            end;
 174   SERVICE_RUNNING:         begin
 175                              Label3.Caption := 'RUNNING';
 176                              E_Stop := TRUE;
 177                              E_Paus := TRUE;
 178                              E_Remv := TRUE;
 179                            end;
 180   SERVICE_CONTINUE_PENDING:begin
 181                              Label3.Caption := 'Resuming...';
 182                              E_Stop := TRUE;
 183                              E_Remv := TRUE;
 184                            end;
 185   SERVICE_PAUSE_PENDING:   begin
 186                              Label3.Caption := 'Pausing...';
 187                              E_Remv := TRUE;
 188                            end;
 189   SERVICE_PAUSED:          begin
 190                              Label3.Caption := 'Paused';
 191                              E_Resm := TRUE;
 192                              E_Stop := TRUE;
 193                              E_Remv := TRUE;
 194                            end;
 195   end;
 196   Button1   .Enabled := E_Inst;
 197   Button6   .Enabled := E_Remv;
 198   Button2   .Enabled := E_Strt;
 199   Button3   .Enabled := E_Stop;
 200   Button4   .Enabled := E_Paus;
 201   Button5   .Enabled := E_Resm;
 202   SrvCtl.Free;
 203 end;
 204
 205 procedure TForm1.btnInstallClick(Sender: PObj);
 206 var SrvCtl: PServiceCtl;
 207 begin
 208     SrvCtl := NewServiceCtl( '',
 209                              '',
 210                              'KOL_ServiceA',
 211                              'KOL_ServiceA',
 212                              GetStartDir + 'TestKOLService.exe',
 213                              '',
 214                              '',
 215                              '',
 216                              '',
 217                              SERVICE_ALL_ACCESS,
 218                              SERVICE_WIN32_OWN_PROCESS or
 219                              SERVICE_INTERACTIVE_PROCESS,
 220                              SERVICE_DEMAND_START,
 221                              SERVICE_ERROR_NORMAL );
 222     if BadHandles( SrvCtl ) then Exit;
 223     SrvCtl.Free;
 224     RefreshStatus;
 225     ShowMessage( 'Installed OK.' );
 226 end;
 227
 228 procedure TForm1.Button1Click(Sender: PObj);
 229 var SrvCtl: PServiceCtl;
 230 begin
 231     SrvCtl := NewServiceCtl( '',
 232                              '',
 233                              'KOL_ServiceB',
 234                              'KOL_ServiceB',
 235                              GetStartDir + 'TestKOLService.exe',
 236                              '',
 237                              '',
 238                              '',
 239                              '',
 240                              SERVICE_ALL_ACCESS,
 241                              SERVICE_WIN32_OWN_PROCESS or
 242                              SERVICE_INTERACTIVE_PROCESS,
 243                              SERVICE_DEMAND_START,
 244                              SERVICE_ERROR_NORMAL );
 245     if BadHandles( SrvCtl ) then Exit;
 246     SrvCtl.Free;
 247     RefreshStatus;
 248     ShowMessage( 'Installed OK.' );
 249 end;
 250
 251 procedure TForm1.btnStartClick(Sender: PObj);
 252 var SrvCtl: PServiceCtl;
 253     OK: Boolean;
 254 begin
 255     SrvCtl := OpenServiceCtl( '', '', 'KOL_ServiceA', SERVICE_ALL_ACCESS );
 256     if BadHandles( SrvCtl ) then Exit;
 257     OK := SrvCtl.Start( [ 'param1', 'param2', 'param3' ] );
 258     SrvCtl.Free;
 259     if not OK then
 260       ShowMessage( SysErrorMessage( GetLastError ) );
 261     RefreshStatus;
 262 end;
 263
 264 procedure TForm1.Button2Click(Sender: PObj);
 265 var SrvCtl: PServiceCtl;
 266     OK: Boolean;
 267 begin
 268     SrvCtl := OpenServiceCtl( '', '', 'KOL_ServiceB', SERVICE_ALL_ACCESS );
 269     if BadHandles( SrvCtl ) then Exit;
 270     OK := SrvCtl.Start( [ 'param1', 'param2', 'param3' ] );
 271     SrvCtl.Free;
 272     if not OK then
 273       ShowMessage( SysErrorMessage( GetLastError ) );
 274     RefreshStatus;
 275 end;
 276
 277 function TForm1.BadHandles(SrvCtl: PServiceCtl): Boolean;
 278 begin
 279   Result := FALSE;
 280   if SrvCtl.SCHandle = 0 then
 281   begin
 282     ShowMessage( 'Can not obtain SCHandle, ' + SysErrorMessage( GetLastError ) );
 283     SrvCtl.Free;
 284     Result := TRUE;
 285     Exit;
 286   end;
 287   if SrvCtl.Handle = 0 then
 288   begin
 289     ShowMessage( 'Can not obtain service handle, ' + SysErrorMessage( GetLastError ) );
 290     SrvCtl.Free;
 291     Result := TRUE;
 292     Exit;
 293   end;
 294 end;
 295
 296 procedure TForm1.btnStopClick(Sender: PObj);
 297 var SrvCtl: PServiceCtl;
 298     OK: Boolean;
 299 begin
 300     SrvCtl := OpenServiceCtl( '', '', 'KOL_ServiceA', SERVICE_ALL_ACCESS );
 301     if BadHandles( SrvCtl ) then Exit;
 302     OK := SrvCtl.Stop;
 303     SrvCtl.Free;
 304     if not OK then
 305       ShowMessage( SysErrorMessage( GetLastError ) );
 306     RefreshStatus;
 307 end;
 308
 309 procedure TForm1.Button3Click(Sender: PObj);
 310 var SrvCtl: PServiceCtl;
 311     OK: Boolean;
 312 begin
 313     SrvCtl := OpenServiceCtl( '', '', 'KOL_ServiceB', SERVICE_ALL_ACCESS );
 314     if BadHandles( SrvCtl ) then Exit;
 315     OK := SrvCtl.Stop;
 316     SrvCtl.Free;
 317     if not OK then
 318       ShowMessage( SysErrorMessage( GetLastError ) );
 319     RefreshStatus;
 320 end;
 321
 322 procedure TForm1.btnPauseClick(Sender: PObj);
 323 var SrvCtl: PServiceCtl;
 324     OK: Boolean;
 325 begin
 326     SrvCtl := OpenServiceCtl( '', '', 'KOL_ServiceA', SERVICE_ALL_ACCESS );
 327     if BadHandles( SrvCtl ) then Exit;
 328     OK := SrvCtl.Pause;
 329     SrvCtl.Free;
 330     if not OK then
 331       ShowMessage( SysErrorMessage( GetLastError ) );
 332     RefreshStatus;
 333 end;
 334
 335 procedure TForm1.Button4Click(Sender: PObj);
 336 var SrvCtl: PServiceCtl;
 337     OK: Boolean;
 338 begin
 339     SrvCtl := OpenServiceCtl( '', '', 'KOL_ServiceB', SERVICE_ALL_ACCESS );
 340     if BadHandles( SrvCtl ) then Exit;
 341     OK := SrvCtl.Pause;
 342     SrvCtl.Free;
 343     if not OK then
 344       ShowMessage( SysErrorMessage( GetLastError ) );
 345     RefreshStatus;
 346 end;
 347
 348 procedure TForm1.btnResumeClick(Sender: PObj);
 349 var SrvCtl: PServiceCtl;
 350     OK: Boolean;
 351 begin
 352     SrvCtl := OpenServiceCtl( '', '', 'KOL_ServiceA', SERVICE_ALL_ACCESS );
 353     if BadHandles( SrvCtl ) then Exit;
 354     OK := SrvCtl.Resume;
 355     SrvCtl.Free;
 356     if not OK then
 357       ShowMessage( SysErrorMessage( GetLastError ) );
 358     RefreshStatus;
 359 end;
 360
 361 procedure TForm1.Button5Click(Sender: PObj);
 362 var SrvCtl: PServiceCtl;
 363     OK: Boolean;
 364 begin
 365     SrvCtl := OpenServiceCtl( '', '', 'KOL_ServiceB', SERVICE_ALL_ACCESS );
 366     if BadHandles( SrvCtl ) then Exit;
 367     OK := SrvCtl.Resume;
 368     SrvCtl.Free;
 369     if not OK then
 370       ShowMessage( SysErrorMessage( GetLastError ) );
 371     RefreshStatus;
 372 end;
 373
 374 procedure TForm1.btnRemoveClick(Sender: PObj);
 375 var SrvCtl: PServiceCtl;
 376     OK: Boolean;
 377     Count: Integer;
 378 begin
 379   SrvCtl := OpenServiceCtl( '', '', 'KOL_ServiceA', SERVICE_ALL_ACCESS );
 380   if BadHandles( SrvCtl ) then Exit;
 381   SrvCtl.Stop;
 382   Count := 30; // wait 3 seconds
 383   while SrvCtl.Status.dwCurrentState = SERVICE_STOP_PENDING do
 384   begin
 385     Sleep( 100 );
 386     Dec( Count );
 387     if Count = 0 then break;
 388   end;
 389   //if SrvCtl.Status.dwCurrentState = SERVICE_STOPPED then
 390   OK := SrvCtl.Delete;
 391   SrvCtl.Free;
 392   if not OK then
 393     ShowMessage( SysErrorMessage( GetLastError ) );
 394   RefreshStatus;
 395 end;
 396
 397 procedure TForm1.Button6Click(Sender: PObj);
 398 var SrvCtl: PServiceCtl;
 399     OK: Boolean;
 400     Count: Integer;
 401 begin
 402   SrvCtl := OpenServiceCtl( '', '', 'KOL_ServiceB', SERVICE_ALL_ACCESS );
 403   if BadHandles( SrvCtl ) then Exit;
 404   SrvCtl.Stop;
 405   Count := 30; // wait 3 seconds
 406   while SrvCtl.Status.dwCurrentState = SERVICE_STOP_PENDING do
 407   begin
 408     Sleep( 100 );
 409     Dec( Count );
 410     if Count = 0 then break;
 411   end;
 412   //if SrvCtl.Status.dwCurrentState = SERVICE_STOPPED then
 413   OK := SrvCtl.Delete;
 414   SrvCtl.Free;
 415   if not OK then
 416     ShowMessage( SysErrorMessage( GetLastError ) );
 417   RefreshStatus;
 418 end;
 419
 420 procedure TForm1.fmControlKOLServiceFormCreate(Sender: PObj);
 421 begin
 422   RefreshStatus;
 423 end;
 424
 425 procedure TForm1.RefreshStatus;
 426 begin
 427   Form.CreateWindow;
 428   PostMessage( Form.Handle, WM_USER, 0, 0 );
 429 end;
 430
 431 function TForm1.fmControlKOLServiceMessage(var Msg: tagMSG;
 432   var Rslt: Integer): Boolean;
 433 begin
 434   if Msg.message = WM_USER then
 435     DoRefreshStatus;
 436   Result := FALSE;
 437 end;
 438
 439 procedure TForm1.Timer1Timer(Sender: PObj);
 440 begin
 441   DoRefreshStatus;
 442 end;
 443
 444 end.
 445
 446