这是我使用的代码,创建了一个基于纯API的非常小的服务。可执行文件仅有50K大小,可能可以更小,因为我使用了一些可省略的其他单元。编译器使用的是Delphi 7。也许使用新的编译器会更大,但我没有检查过。
这段代码非常古老,我没检查过它。我几年前写的,所以请把它当作一个例子,不要直接复制粘贴。
program PureAPIService;
{$APPTYPE CONSOLE}
{$IF CompilerVersion > 20}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
{$WEAKLINKRTTI ON}
{$IFEND}
uses
Windows,
WinSvc;
const
ServiceName = 'PureAPIService';
DisplayName = 'Pure Windows API Service';
NUM_OF_SERVICES = 2;
var
ServiceStatus : TServiceStatus;
StatusHandle : SERVICE_STATUS_HANDLE;
ServiceTable : array [0..NUM_OF_SERVICES] of TServiceTableEntry;
Stopped : Boolean;
Paused : Boolean;
var
ghSvcStopEvent: Cardinal;
procedure OnServiceCreate;
begin
end;
procedure AfterUninstall;
begin
end;
procedure ReportSvcStatus(dwCurrentState, dwWin32ExitCode, dwWaitHint: DWORD);
begin
ServiceStatus.dwCurrentState := dwCurrentState;
ServiceStatus.dwWin32ExitCode := dwWin32ExitCode;
ServiceStatus.dwWaitHint := dwWaitHint;
case dwCurrentState of
SERVICE_START_PENDING: ServiceStatus.dwControlsAccepted := 0;
else
ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP;
end;
case (dwCurrentState = SERVICE_RUNNING) or (dwCurrentState = SERVICE_STOPPED) of
True: ServiceStatus.dwCheckPoint := 0;
False: ServiceStatus.dwCheckPoint := 1;
end;
SetServiceStatus(StatusHandle, ServiceStatus);
end;
procedure MainProc;
begin
ghSvcStopEvent := CreateEvent(nil, True, False, nil);
if ghSvcStopEvent = 0 then
begin
ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
Exit;
end;
ReportSvcStatus( SERVICE_RUNNING, NO_ERROR, 0 );
while True do
begin
WaitForSingleObject(ghSvcStopEvent, INFINITE);
ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
Exit;
end;
end;
procedure ServiceCtrlHandler(Control: DWORD); stdcall;
begin
case Control of
SERVICE_CONTROL_STOP:
begin
Stopped := True;
SetEvent(ghSvcStopEvent);
ServiceStatus.dwCurrentState := SERVICE_STOP_PENDING;
SetServiceStatus(StatusHandle, ServiceStatus);
end;
SERVICE_CONTROL_PAUSE:
begin
Paused := True;
ServiceStatus.dwcurrentstate := SERVICE_PAUSED;
SetServiceStatus(StatusHandle, ServiceStatus);
end;
SERVICE_CONTROL_CONTINUE:
begin
Paused := False;
ServiceStatus.dwCurrentState := SERVICE_RUNNING;
SetServiceStatus(StatusHandle, ServiceStatus);
end;
SERVICE_CONTROL_INTERROGATE: SetServiceStatus(StatusHandle, ServiceStatus);
SERVICE_CONTROL_SHUTDOWN: Stopped := True;
end;
end;
procedure RegisterService(dwArgc: DWORD; var lpszArgv: PChar); stdcall;
begin
ServiceStatus.dwServiceType := SERVICE_WIN32_OWN_PROCESS;
ServiceStatus.dwCurrentState := SERVICE_START_PENDING;
ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE;
ServiceStatus.dwServiceSpecificExitCode := 0;
ServiceStatus.dwWin32ExitCode := 0;
ServiceStatus.dwCheckPoint := 0;
ServiceStatus.dwWaitHint := 0;
StatusHandle := RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
if StatusHandle <> 0 then
begin
ReportSvcStatus(SERVICE_RUNNING, NO_ERROR, 0);
try
Stopped := False;
Paused := False;
MainProc;
finally
ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
end;
end;
end;
procedure UninstallService(const ServiceName: PChar; const Silent: Boolean);
const
cRemoveMsg = 'Your service was removed sucesfuly!';
var
SCManager: SC_HANDLE;
Service: SC_HANDLE;
begin
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager = 0 then
Exit;
try
Service := OpenService(SCManager, ServiceName, SERVICE_ALL_ACCESS);
ControlService(Service, SERVICE_CONTROL_STOP, ServiceStatus);
DeleteService(Service);
CloseServiceHandle(Service);
if not Silent then
MessageBox(0, cRemoveMsg, ServiceName, MB_ICONINFORMATION or MB_OK or MB_TASKMODAL or MB_TOPMOST);
finally
CloseServiceHandle(SCManager);
AfterUninstall;
end;
end;
procedure InstallService(const ServiceName, DisplayName, LoadOrder: PChar;
const FileName: string; const Silent: Boolean);
const
cInstallMsg = 'Your service was Installed sucesfuly!';
cSCMError = 'Error trying to open SC Manager';
var
SCMHandle : SC_HANDLE;
SvHandle : SC_HANDLE;
begin
SCMHandle := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCMHandle = 0 then
begin
MessageBox(0, cSCMError, ServiceName, MB_ICONERROR or MB_OK or MB_TASKMODAL or MB_TOPMOST);
Exit;
end;
try
SvHandle := CreateService(SCMHandle,
ServiceName,
DisplayName,
SERVICE_ALL_ACCESS,
SERVICE_WIN32_OWN_PROCESS,
SERVICE_AUTO_START,
SERVICE_ERROR_IGNORE,
pchar(FileName),
LoadOrder,
nil,
nil,
nil,
nil);
CloseServiceHandle(SvHandle);
if not Silent then
MessageBox(0, cInstallMsg, ServiceName, MB_ICONINFORMATION or MB_OK or MB_TASKMODAL or MB_TOPMOST);
finally
CloseServiceHandle(SCMHandle);
end;
end;
procedure WriteHelpContent;
begin
WriteLn('To install your service please type <service name> /install');
WriteLn('To uninstall your service please type <service name> /remove');
WriteLn('For help please type <service name> /? or /h');
end;
begin
if (ParamStr(1) = '/h') or (ParamStr(1) = '/?') then
WriteHelpContent
else if ParamStr(1) = '/install' then
InstallService(ServiceName, DisplayName, 'System Reserved', ParamStr(0), ParamStr(2) = '/s')
else if ParamStr(1) = '/remove' then
UninstallService(ServiceName, ParamStr(2) = '/s')
else if ParamCount = 0 then
begin
OnServiceCreate;
ServiceTable[0].lpServiceName := ServiceName;
ServiceTable[0].lpServiceProc := @RegisterService;
ServiceTable[1].lpServiceName := nil;
ServiceTable[1].lpServiceProc := nil;
StartServiceCtrlDispatcher(ServiceTable[0]);
end
else
WriteLn('Wrong argument!');
end.
编辑:
我在没有使用资源和SysUtils的情况下编译了上述代码。在 Delphi XE 下,我得到了32KB的可执行文件,在 Delphi 2006 下得到了22KB的可执行文件。在 XE 下,我删除了 RTTI 信息。我会在博客中介绍这个过程,因为它很有趣。我想知道 C++ 可执行文件的大小。
编辑2:
我更新了代码,现在是可工作的代码。大多数较大的错误应该已经被解决了。但它仍然不能称为生产质量的代码。
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
是要使用的行。将其放入一个文件中,然后在每个单元中都包含该文件。 - Marjan Venema