source: components/CoolTrayIcon/demos/CoolService/Service.pas

Last change on this file was 1, checked in by maron, 16 years ago

3.1 verze, první revize

File size: 3.5 KB
Line 
1unit Service;
2
3interface
4
5uses
6 Windows, Classes, SvcMgr, Menus, CoolTrayIcon;
7
8type
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
27var
28 CoolTrayService: TCoolTrayService;
29
30implementation
31
32uses
33 ShellApi, WinSvc, Registry, SysUtils, Dialogs;
34
35{$R *.DFM}
36
37function ServiceStop(aMachine, aServiceName: String): Boolean;
38// aMachine is UNC path or local machine if empty
39var
40 h_manager, h_svc: SC_Handle;
41 ServiceStatus: TServiceStatus;
42 dwCheckPoint: DWORD;
43begin
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);
73end;
74
75
76procedure ServiceController(CtrlCode: DWord); stdcall;
77begin
78 CoolTrayService.Controller(CtrlCode);
79end;
80
81
82function TCoolTrayService.GetServiceController: TServiceController;
83begin
84 Result := ServiceController;
85end;
86
87
88procedure TCoolTrayService.ServiceExecute(Sender: TService);
89begin
90// ShowMessage('Start executing.');
91 while not Terminated do
92 begin
93 ServiceThread.ProcessRequests(False);
94 end;
95// ShowMessage('Done executing. Bye.');
96end;
97
98
99procedure TCoolTrayService.StopService1Click(Sender: TObject);
100begin
101// WinExec(PChar('net stop '+Name), 0); // Dirty indeed! Use ControlService in stead!
102 ServiceStop('', Name);
103 ReportStatus; // Notify the Service Manager (Windows)
104end;
105
106
107procedure TCoolTrayService.ServiceAfterInstall(Sender: TService);
108// Registers the service's description
109var
110 Reg: TRegistry;
111begin
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;
122end;
123
124
125procedure TCoolTrayService.SetValue1Click(Sender: TObject);
126begin
127 Randomize;
128 MagicNumber := Random(100);
129 GetValue1Click(Self);
130end;
131
132
133procedure TCoolTrayService.GetValue1Click(Sender: TObject);
134begin
135 MessageDlg('Magic number is ' + IntToStr(MagicNumber), mtInformation, [mbOK], 0);
136end;
137
138end.
139
Note: See TracBrowser for help on using the repository browser.