为什么 ControlService 老是失败！
//Windows服务的代码：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;
const
WM_SERVICE_TEST = WM_USER + 299;
type
TService1 = class(TService)
private
{ Private declarations }
protected
function DoCustomControl(CtrlCode: DWord): Boolean; override;
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
Service1: TService1;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service1.Controller(CtrlCode);
end;
function TService1.DoCustomControl(CtrlCode: DWord): Boolean;
begin
case CtrlCode of
WM_SERVICE_TEST:
begin
MessageBox(0, '测试服务自定义消息！ ', '测试 ', MB_OK+MB_ICONINFORMATION);
end;
end;
Result := True;
end;
function TService1.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
end.
//测试应用程序：
unit Unit1Exe;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
WM_SERVICE_TEST = WM_USER + 299;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses SvcMgr, WinSvc;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
MHnd, SHnd: SC_HANDLE;
SerStatus: _SERVICE_STATUS;
begin
MHnd := OpenSCManager( ' ', nil, SC_MANAGER_ALL_ACCESS);
if MHnd <> 0 then
try
SHnd := OpenService(MHnd, PChar( 'Service1 '), SERVICE_ALL_ACCESS);
if SHnd <> 0 then
try
if QueryServiceStatus(SHnd, SerStatus) then
if SerStatus.dwCurrentState = SERVICE_RUNNING then
if not ControlService(SHnd, WM_SERVICE_TEST, SerStatus) then
ShowMessage( '失败！ ');
finally
CloseServiceHandle(SHnd);
end;
finally
CloseServiceHandle(MHnd);
end;
end;
end.
//为什么 ControlService 不能成功，老是提示失败！
[解决办法]
如果要自己定义服务的控制行为，需要override服务的DoCustomControl：
function TSvrXXXXX.DoCustomControl(CtrlCode: DWord): Boolean;
begin
Result := inherited DoCustomControl(CtrlCode);
case CtrlCode of
0:;
end;
end;
注意：CtrlCode的值必须大于128！
而外部的控制可以使用API函数ControlService来做：
function ServiceControl(const ServiceName: string; const ControlCode: integer;const Computer: PChar = nil): Boolean;
{
控制系统服务，可以指定代码: ControlCode 必须在 [128,255]
}
var
SCM, SCH: SC_Handle;
ServiceStatus: TServiceStatus;
begin
if IsLocalComputer(Computer) then
SCM := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS)
else
SCM := OpenSCManager(Computer, nil, SC_MANAGER_ALL_ACCESS);
if SCM <> 0 then
begin
SCH := OpenService(SCM, PChar(ServiceName), SERVICE_ALL_ACCESS);
if SCH <> 0 then
begin
Result := ControlService(SCH, ControlCode, ServiceStatus);
CloseServiceHandle(SCH);
end;
CloseServiceHandle(SCM);
end;
end;
需要注意的是，服务和控制部分的CtrlCode的定义必须一致！同时CtrolCode必须在128-255之间！