Opret en lille og kortfattet windows service ved hjælp af Delphi

Indlæg af Hanne Mølgaard Plasc

Problem



Jeg har oprettet en meget enkel Windows Service App opdaterer nogle datafiler kronologisk med Delphi. Tjenesteprogrammet kompilerer og fungerer godt, men jeg er ikke tilfreds med den endelige exe-filstørrelse. Dens over 900K. Tjenesten i sig selv bruger ikke Formularer, Dialoger, men alligevel ser jeg, at SvcMgr refererer til Forms og andet stort crap, jeg ikke bruger.


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


Er der en måde, hvorpå jeg kan gøre tjenesteapplikationen mindre? eller er der en anden serviceskabelon, jeg kan bruge uden at bruge formularer osv.?

Bedste reference


Her er koden, jeg plejede at oprette en meget lille tjeneste baseret på ren API. Størrelsen af ​​exe er kun 50K. Sandsynligvis kunne være endnu mindre, jeg brugte nogle andre enheder, der kunne blive omiteret. Den anvendte kompilator var Delphi 7. Sandsynligvis vil være større med nye kompilatorer, men jeg kontrollerede ikke.


Koden er meget gammel, og jeg kontrollerede ikke den. Jeg skrev det for mange år siden. Så tag det som et eksempel, ikke kopier og indsæt venligst.


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


Jeg kompilerede ovenstående kode uden ressourcer og SysUtils. Jeg fik 32KB eksekverbar under Delphi XE og 22KB eksekverbar under Delphi 2006. Under XE fjernede jeg RTTI informationen. Jeg vil blogge om dette, fordi det er interessant. Jeg vil gerne vide, hvor stor er C + + eksekverbar.


Edit2:


Jeg opdaterede koden. Det er en arbejdskode nu. De fleste af de større bugs skal være væk. Det er stadig ikke produktionskvalitet.

Andre referencer 1


Du kan gøre uden den 'store crap'. Men så er du nødt til at tale med Windows API selv. Se kilden til spor.


Den 'store crap' er der for at gøre kodning lettere for dig. Det handler om et fald i designtiden for en stigning i kodestørrelse. Det er bare et spørgsmål om, hvad du synes er vigtigt.


Desuden har du samlet uden fejlfindingsoplysninger? Fejloplysninger øger exe-størrelsen meget.

Andre referencer 2


Hvis du bruger Delphi 6 eller 7, skal du kigge på vores LVCL open source biblioteker. [4]


Her finder du nogle udskiftninger til standard VCL-enheder med meget mindre kodevægt. Det har grundlæggende GUI-komponenter (TLabel/TEdit og sådan), kun hvad der var nødvendigt for at oprette et installationsprogram. Men det var designet til at blive brugt uden enhver GUI.


Eksekverbar størrelse vil være mindre end med standard VCL enheder, selvom du kun bruger SysUtils og Classes enheder. Og det vil også være hurtigere end VCL for nogle operationer (jeg har allerede medtaget FastCode-del eller omskrevet en anden del i ASM). Perfekt til en baggrunds service.


For at håndtere baggrundstjenesten er der SQLite3Service.pas-enheden, som fungerer perfekt med LVCL. Det er mere højt end direkte API-opkald. [5]


Her er et perfekt fungerende baggrunds 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.


Du kan skrive yderligere spørgsmål på vores forum, hvis du ønsker det. [6]

Andre referencer 3


Du kan altid bruge Visual Studio service skabelonen til at oprette en lille service vært, der kaldte din Delphi kode kompileret til en DLL. Lidt sjusket men sandsynligvis den enkleste måde at skære størrelsen ned fra, hvor du er. Den simple gør ingenting service er en 91KB ved hjælp af statisk linking eller 36KB med dynamisk link til C runtime.