我用Delphi创建了一个非常简单的Windows服务应用程序，用于按时间顺序更新一些数据文件。这个服务应用程序编译后运行良好，但是我对最终的exe文件大小不满意。它超过了900K。服务本身不使用表单、对话框，但我看到SvcMgr在引用表单和其他我没有使用的大型组件。
Name Size Group Package
------------ ------ ----- -------
Controls 80,224 CODE
Forms 61,204 CODE
Classes 46,081 CODE
Graphics 37,054 CODE
我能否让服务应用程序更小？或者有没有其他的服务模板可以使用，而不需要使用表单等？
这是我使用的代码，创建了一个基于纯API的非常小的服务。可执行文件仅有50K大小，可能可以更小，因为我使用了一些可省略的其他单元。编译器使用的是Delphi 7。也许使用新的编译器会更大，但我没有检查过。
这段代码非常古老，我没检查过它。我几年前写的，所以请把它当作一个例子，不要直接复制粘贴。
{
NT Service model based completely on API calls. Version 0.1
Inspired by NT service skeleton from Aphex
Adapted by Runner
}
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
// do your stuff here;
end;
procedure AfterUninstall;
begin
// do your stuff here;
end;
procedure ReportSvcStatus(dwCurrentState, dwWin32ExitCode, dwWaitHint: DWORD);
begin
// fill in the SERVICE_STATUS structure.
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;
// Report the status of the service to the SCM.
SetServiceStatus(StatusHandle, ServiceStatus);
end;
procedure MainProc;
begin
// we have to do something or service will stop
ghSvcStopEvent := CreateEvent(nil, True, False, nil);
if ghSvcStopEvent = 0 then
begin
ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
Exit;
end;
// Report running status when initialization is complete.
ReportSvcStatus( SERVICE_RUNNING, NO_ERROR, 0 );
// Perform work until service stops.
while True do
begin
// Check whether to stop the service.
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:
我更新了代码，现在是可工作的代码。大多数较大的错误应该已经被解决了。但它仍然不能称为生产质量的代码。
您可以不用“庞大的东西”。但是那样您就必须自己去与Windows API交流。查看源代码以获取提示。
“庞大的东西”存在的目的是为了让您编码更轻松。它在设计时间上牺牲了一些，却增加了代码大小。这只是取决于您认为什么更重要的问题。
此外，您编译时是否没有开启调试信息？调试信息会大大增加exe文件的大小。
/// implements a background Service
program Background_Service;
uses
Windows,
Classes,
SysUtils,
WinSvc,
SQLite3Service;
// define this conditional if you want the GDI messages to be accessible
// from the background service
{$define USEMESSAGES}
type
/// class implementing the background Service
TMyService = class(TService)
public
/// the background Server processing all requests
// - TThread should be replaced by your own process
Server: TThread;
/// event trigerred to start the service
// - e.g. create the Server instance
procedure DoStart(Sender: TService);
/// event trigerred to stop the service
// - e.g. destroy the Server instance
procedure DoStop(Sender: TService);
/// initialize the background Service
constructor Create; reintroduce;
/// release memory
destructor Destroy; override;
end;
const
SERVICENAME = 'MyService';
SERVICEDISPLAYNAME = 'My service';
{ TMyService }
constructor TMyService.Create;
begin
inherited Create(SERVICENAME,SERVICEDISPLAYNAME);
OnStart := DoStart;
OnStop := DoStop;
OnResume := DoStart; // trivial Pause/Resume actions
OnPause := DoStop;
end;
destructor TMyService.Destroy;
begin
FreeAndNil(Server);
inherited;
end;
procedure TMyService.DoStart(Sender: TService);
begin
if Server<>nil then
DoStop(nil); // should never happen
Server := TThread.Create(false);
end;
procedure TMyService.DoStop(Sender: TService);
begin
FreeAndNil(Server);
end;
procedure CheckParameters;
var i: integer;
param: string;
begin
with TServiceController.CreateOpenService('','',SERVICENAME) do
// allow to control the service
try
if State<>ssErrorRetrievingState then
for i := 1 to ParamCount do begin
param := paramstr(i);
if param='/install' then
TServiceController.CreateNewService('','',SERVICENAME,
SERVICEDISPLAYNAME, paramstr(0),'','','','',
SERVICE_ALL_ACCESS,
SERVICE_WIN32_OWN_PROCESS
{$ifdef USEMESSAGES}or SERVICE_INTERACTIVE_PROCESS{$endif},
SERVICE_AUTO_START). // auto start at every boot
Free else
if param='/remove' then begin
Stop;
Delete;
end else
if param='/stop' then
Stop else
if param='/start' then
Start([]);
end;
finally
Free;
end;
end;
var Service: TMyService;
begin
if ParamCount<>0 then
CheckParameters else begin
Service := TMyService.Create;
try
// launches the registered Services execution = do all the magic
ServicesRun;
finally
Service.Free;
end;
end;
end.
如果您愿意，您可以在我们的论坛发布其他问题。
您可以使用Visual Studio服务模板创建一个小型服务主机，调用编译为DLL的Delphi代码。虽然有点凌乱，但从您现在的起点开始，这可能是最简单的缩小大小的方法。简单的无操作服务使用静态链接为91KB，或者使用动态链接到C运行时为36KB。
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}是要使用的行。将其放入一个文件中，然后在每个单元中都包含该文件。 - Marjan Venema