Create a small and concise windows service using Delphi

Question

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.

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?

Solution 1

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.

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.

EDIT2:

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.

Solution 2

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.

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.

Solution 3

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

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.

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.

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

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.

Comments

[Runner]

It can be done just fine in Delphi. My example below produces 50K large service that does everything that a Delphi service can do. In most cases this is completely unnecessary, but it can come in handy. If nothing else, then as a learning process. Anyway he is asking to make a small executable in Delphi, so your comment is a little rude.

[Darkerstar]

and yes, in the meantime I am looking the source code to extract the core APIs it uses. I very much like KOL, for its small apps it produce. :)

[Admin]

You could probably also remove the install/uninstall functionalities and install the service using sc.exe or something alike.

[Runner]

Probably yes, as I said it is a very old example. And knowing how to do it inside the code is a plus. But it can be striped out.

[Arnaud Bouchez]

So 91 KB is bigger than the Delphi executable calling directly WinSVC API. So not worth changing both IDE and language! ;)

[David Heffernan]

True, but the service app would be even smaller in MSVC than Delphi if it was written directly against the Windows API rather than using the built in project template. The 91KB quoted here is for the service created from the built-in template.

[Arnaud Bouchez]

At this level of executable size, some KB doesn't make much sense. Just loading the exe, linking it to Windows dll, and initializing its memory manager will use much more RAM than that. Exe size doesn't mean much.

[David Heffernan]

@A.Bouchez Well, I basically agree with that too, but the OP did ask the question. I do find unnecessary waste irritating though, almost on a point of principle.

[Arnaud Bouchez]

Compiled with LVCL, the above example compiles into a Background_Service.exe file of 27,136 bytes. With full VCL compatible classes at hand.

[Runner]

Impressive! Will have a look at it.

[Mick]

I must be missing something, because although this works, I can't get it to accept my stop requests when using this in a larger service project...via "sc stop svcname". Any ideas?