home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / ChipCD_1.03.iso / zkuste / delphi / kompon / d23456 / COOLTRAY.ZIP / demos / CoolService / Service.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2002-07-12  |  3.5 KB  |  140 lines
  1. unit Service;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Classes, SvcMgr, Menus, CoolTrayIcon;
  7.  
  8. type
  9.   TCoolTrayService = class(TService)
  10.     CoolTrayIcon1: TCoolTrayIcon;
  11.     PopupMenu1: TPopupMenu;
  12.     GetValue1: TMenuItem;
  13.     SetValue1: TMenuItem;
  14.     N1: TMenuItem;
  15.     StopService1: TMenuItem;
  16.     procedure ServiceExecute(Sender: TService);
  17.     procedure StopService1Click(Sender: TObject);
  18.     procedure ServiceAfterInstall(Sender: TService);
  19.     procedure SetValue1Click(Sender: TObject);
  20.     procedure GetValue1Click(Sender: TObject);
  21.   public
  22.     function GetServiceController: TServiceController; override;
  23.   private
  24.     MagicNumber: Integer;
  25.   end;
  26.  
  27. var
  28.   CoolTrayService: TCoolTrayService;
  29.  
  30. implementation
  31.  
  32. uses
  33.   ShellApi, WinSvc, Registry, SysUtils, Dialogs;
  34.  
  35. {$R *.DFM}
  36.  
  37. function ServiceStop(aMachine, aServiceName: String): Boolean;
  38. // aMachine is UNC path or local machine if empty
  39. var
  40.   h_manager, h_svc: SC_Handle;
  41.   ServiceStatus: TServiceStatus;
  42.   dwCheckPoint: DWORD;
  43. begin
  44.   h_manager := OpenSCManager(PChar(aMachine), nil, SC_MANAGER_CONNECT);
  45.   if h_manager > 0 then
  46.   begin
  47.     h_svc := OpenService(h_manager, PChar(aServiceName),
  48.                          SERVICE_STOP or SERVICE_QUERY_STATUS);
  49.     if h_svc > 0 then
  50.     begin
  51.       if (ControlService(h_svc, SERVICE_CONTROL_STOP, ServiceStatus)) then
  52.       begin
  53.         if (QueryServiceStatus(h_svc, ServiceStatus)) then
  54.         begin
  55.           while (SERVICE_STOPPED <> ServiceStatus.dwCurrentState) do
  56.           begin
  57.             dwCheckPoint := ServiceStatus.dwCheckPoint;
  58.             Sleep(ServiceStatus.dwWaitHint);
  59.             if (not QueryServiceStatus(h_svc, ServiceStatus)) then
  60.               // couldn't check status
  61.               break;
  62.             if (ServiceStatus.dwCheckPoint < dwCheckPoint) then
  63.               break;
  64.           end;
  65.         end;
  66.       end;
  67.       CloseServiceHandle(h_svc);
  68.     end;
  69.     CloseServiceHandle(h_manager);
  70.   end;
  71.  
  72.   Result := (SERVICE_STOPPED = ServiceStatus.dwCurrentState);
  73. end;
  74.  
  75.  
  76. procedure ServiceController(CtrlCode: DWord); stdcall;
  77. begin
  78.   CoolTrayService.Controller(CtrlCode);
  79. end;
  80.  
  81.  
  82. function TCoolTrayService.GetServiceController: TServiceController;
  83. begin
  84.   Result := ServiceController;
  85. end;
  86.  
  87.  
  88. procedure TCoolTrayService.ServiceExecute(Sender: TService);
  89. begin
  90. //  ShowMessage('Start executing.');
  91.   while not Terminated do
  92.   begin
  93.     ServiceThread.ProcessRequests(False);
  94.   end;
  95. //  ShowMessage('Done executing. Bye.');
  96. end;
  97.  
  98.  
  99. procedure TCoolTrayService.StopService1Click(Sender: TObject);
  100. begin
  101. //  WinExec(PChar('net stop '+Name), 0);  // Dirty indeed! Use ControlService in stead!
  102.   ServiceStop('', Name);
  103.   ReportStatus;              // Notify the Service Manager (Windows)
  104. end;
  105.  
  106.  
  107. procedure TCoolTrayService.ServiceAfterInstall(Sender: TService);
  108. // Registers the service's description
  109. var
  110.   Reg: TRegistry;
  111. begin
  112.   Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
  113.   try
  114.     Reg.RootKey := HKEY_LOCAL_MACHINE;
  115.     if Reg.OpenKey('System\CurrentControlSet\Services\' + Name, True) then
  116.     begin
  117.       Reg.WriteString('Description', 'A sample service using the CoolTrayIcon component.');
  118.     end
  119.   finally
  120.     Reg.Free;
  121.   end;
  122. end;
  123.  
  124.  
  125. procedure TCoolTrayService.SetValue1Click(Sender: TObject);
  126. begin
  127.   Randomize;
  128.   MagicNumber := Random(100);
  129.   GetValue1Click(Self);
  130. end;
  131.  
  132.  
  133. procedure TCoolTrayService.GetValue1Click(Sender: TObject);
  134. begin
  135.   MessageDlg('Magic number is ' + IntToStr(MagicNumber), mtInformation, [mbOK], 0);
  136. end;
  137.  
  138. end.
  139.  
  140.