使用 Delphi 创建一个小巧简洁的 windows 服务

Create a small and concise windows service using Delphi

提问by Darkerstar

I have created very simple windows service app updates some data files chronologically using Delphi. The service app compiles, and works well, but I am not happy with final exe file size. Its over 900K. The service itself do not use Forms, Dialogs, but yet I see SvcMgr is referencing Forms and other large crap I am not using.

我创建了非常简单的 Windows 服务应用程序，使用 Delphi 按时间顺序更新一些数据文件。服务应用程序编译并运行良好，但我对最终的 exe 文件大小不满意。它超过900K。服务本身不使用表单、对话框，但我看到 SvcMgr 正在引用表单和其他我没有使用的大垃圾。

Name           Size Group Package
------------ ------ ----- -------
Controls     80,224 CODE
Forms        61,204 CODE
Classes      46,081 CODE
Graphics     37,054 CODE

Is there a way I can make the service app smaller? or is there another service template I can use without using forms etc?

有没有办法让服务应用程序变小？或者我可以在不使用表单等的情况下使用另一个服务模板吗？

回答by Runner

Here is the code I used to create a very small service based on pure API. The size of the exe is only 50K. Probably could be even smaller, I used some other units that could be omited. The compiler used was Delphi 7. Probably will be larger with new compilers but I did not check.

这是我用来创建一个基于纯 API 的非常小的服务的代码。exe的大小只有50K。可能会更小，我使用了一些可以省略的其他单位。使用的编译器是 Delphi 7。新的编译器可能会更大，但我没有检查。

The code is very old and I did not check it. I wrote that years ago. So take it as an example, do not copy and paste please.

代码很旧，我没有检查它。我多年前写的。所以以它为例，请不要复制和粘贴。

{
  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.

EDIT:

编辑：

I compiled the above code without resources and SysUtils. I got 32KB executable under Delphi XE and 22KB executable under Delphi 2006. Under XE I removed the RTTI information. I will blog about this because it is interesting. I want to know how large is the C++ executable.

我在没有资源和 SysUtils 的情况下编译了上面的代码。我在 Delphi XE 下得到了 32KB 的可执行文件，在 Delphi 2006 下得到了 22KB 的可执行文件。在 XE 下我删除了 RTTI 信息。我会写博客，因为它很有趣。我想知道 C++ 可执行文件有多大。

EDIT2:

编辑2：

I updated the code. It is a working code now. Most of the larger bugs should be gone. It is still by no means production quality.

我更新了代码。它现在是一个工作代码。大多数较大的错误应该消失。它仍然绝不是生产质量。

回答by Toon Krijthe

You can do without the "large crap". But then you have to talk to the windows API yourself. Have a look at the source for clues.

你可以不用“大废话”。但是你必须自己与 windows API 交谈。查看来源以获取线索。

The "large crap" is there to make coding easier for you. It trades a decrease in designtime for an increase in code size. It is just a matter of what you think is important.

“大废话”是为了让您更轻松地进行编码。它用设计时间的减少来换取代码大小的增加。这只是你认为重要的问题。

Besides, have you compiled without debug information? Debug information increase the exe size a lot.

另外，你有没有在没有调试信息的情况下编译？调试信息大大增加了 exe 的大小。

回答by Arnaud Bouchez

If you are using Delphi 6 or 7, take a look at our LVCL open source libraries.

如果您使用的是 Delphi 6 或 7，请查看我们的 LVCL 开源库。

You'll find here some replacements for the standard VCL units, with much less code weight. It has basic GUI components (TLabel/TEdit and such), only what was necessary to create a Setup program. But it was designed to be used without any GUI.

您会在此处找到标准 VCL 单元的一些替代品，代码量要少得多。它具有基本的 GUI 组件（TLabel/TEdit 等），只有创建安装程序所需的组件。但它被设计为在没有任何 GUI 的情况下使用。

Executable size will be smaller than with the standard VCL units, even if you use only SysUtils and Classes units. And it will be also faster than VCL for some operations (I've already included FastCode part, or rewritten some other part in asm). Perfect for a background service.

可执行文件的大小将小于标准 VCL 单元，即使您只使用 SysUtils 和 Classes 单元。对于某些操作，它也会比 VCL 更快（我已经包含了 FastCode 部分，或者在 asm 中重写了一些其他部分）。非常适合后台服务。

To handle background service, there is the SQLite3Service.pasunit, which works perfectly with LVCL. It's more high-level than direct API call.

为了处理后台服务，有SQLite3Service.pas单元，它与 LVCL 完美配合。它比直接 API 调用更高级。

Here is a perfectly working background service program:

这是一个完美运行的后台服务程序：

/// 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.

You can post additional questions on our forum, if you wish.

如果您愿意，您可以在我们的论坛上发布其他问题。

回答by David Heffernan

You could always use the Visual Studio service template to create a small service host that called your Delphi code compiled into a DLL. Slightly untidy but probably the simplest way to cut the size down starting from where you are. The simple do nothing service is a 91KB using static linking or 36KB with dynamic linking to the C runtime.

您始终可以使用 Visual Studio 服务模板来创建一个小型服务主机，它调用编译成 DLL 的 Delphi 代码。有点不整洁，但可能是从您所在的位置开始缩小尺寸的最简单方法。简单的什么都不做的服务是使用静态链接的 91KB 或使用动态链接到 C 运行时的 36KB。