Erstellen Sie eine kleine und prägnante windows service mit Delphi

Hier ist der code, den ich verwendet, um eine sehr kleine service basiert auf reiner API. Die Größe der exe ist nur 50K. Wahrscheinlich könnte sogar noch kleiner, ich habe einige andere Einheiten werden könnte, weggelassen. Der compiler verwendet wurde, war Delphi 7. Wahrscheinlich größer sein wird mit neuen Compilern, aber ich habe nicht überprüfen.

Der code ist sehr alt und ich habe nicht überprüfen. Ich schrieb vor Jahren. So nehmen Sie es als ein Beispiel, nicht kopieren und einfügen, bitte.

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

Ich kompiliert der obige code ohne Ressourcen und SysUtils. Ich habe 32KB ausführbare Datei unter Delphi XE und 22KB ausführbare Datei unter Delphi 2006. Unter XE entfernte ich die RTTI-Informationen. Ich blog über diese, weil es interessant ist. Ich möchte wissen, wie groß ist die C++ - executable.

EDIT2:

Ich aktualisierte den code. Es ist ein funktionierendes code jetzt. Die meisten der größeren bugs Weg sein sollte. Es ist noch keineswegs Qualität in der Produktion.

InformationsquelleAutor Runner

Wenn Sie mit Delphi 6 oder 7, werfen Sie einen Blick auf unsere LVCL open-source-Bibliotheken.

Finden Sie hier einige Ersatz für die standard-VCL-units, mit viel weniger code Gewicht. Es verfügt über grundlegende GUI-Komponenten (TLabel/TEdit und so), nur das, was notwendig war, um ein Setup-Programm erstellen. Aber es wurde entwickelt, um verwendet werden, ohne GUI.

Ausführbare Datei-Größe, wird kleiner als mit dem standard-VCL-Einheiten verwenden, auch wenn Sie nur SysUtils und Classes Einheiten. Und es wird auch schneller als VCL für einige Operationen (hab ich auch schon enthalten FastCode Teil, oder neu geschrieben, einige andere Teil in asm). Perfekt für einen hintergrund-service.

Behandeln Hintergrunddienst, es ist die SQLite3Service.pas Einheit, die funktioniert perfekt mit LVCL. Es ist mehr high-level als direkte API-Aufruf.

Hier ist eine perfekt funktionierende hintergrund-Dienst Programm:

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

Kannst du zusätzliche Fragen auf unserem forum, wenn Sie es wünschen.

InformationsquelleAutor Arnaud Bouchez