Создайте небольшую и лаконичную службу Windows, используя Delphi

Question

Я создал очень простое приложение Windows Service, которое обновляет некоторые файлы данных в хронологическом порядке с использованием Delphi.Сервисное приложение компилируется и работает хорошо, но меня не устраивает окончательный размер исполняемого файла.Его более 900K.Сам сервис не использует Forms, Dialogs, но все же я вижу, что SvcMgr ссылается на Forms и другое большое дерьмо, которым я не пользуюсь.

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

Есть ли способ сделать приложение-сервис меньше?или есть другой шаблон службы, который я могу использовать без использования форм и т. д.

Answer 1

Вот код, который я использовал для создания очень маленького сервиса на основе чистого API.Размер exe только 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.Я получил исполняемый файл размером 32 КБ в Delphi XE и исполняемый файл 22 КБ в Delphi 2006. В XE я удалил информацию RTTI.Я буду вести блог об этом, потому что это интересно.Я хочу знать, насколько велик исполняемый файл C ++.

EDIT2:

Я обновил код.Теперь это рабочий код.Большинство крупных ошибок должно быть устранено.Это еще ни в коем случае не качество продукции.

Answer 2

Можно обойтись без «большой хрени».Но тогда вы должны поговорить с Windows API самостоятельно.Посмотрите на источник подсказок.

"Большая хрень" предназначена для того, чтобы вам было проще писать код.Это меняет время разработки на увеличение размера кода.Это просто вопрос того, что вы считаете важным.

Кроме того, вы компилировали без отладочной информации?Отладочная информация значительно увеличивает размер исполняемого файла.

Answer 3

Если вы используете Delphi 6 или 7, взгляните на наши библиотеки с открытым исходным кодом LVCL .

Здесь вы найдете некоторые замены для стандартных модулей VCL с гораздо меньшим весом кода. Он имеет базовые компоненты GUI (TLabel / TEdit и т. Д.), Только то, что было необходимо для создания программы установки. Но он был разработан для использования без какого-либо графического интерфейса.

Размер исполняемого файла будет меньше, чем у стандартных модулей VCL, даже если вы используете только модули SysUtils и Classes. И это будет также быстрее, чем VCL для некоторых операций (я уже включил часть FastCode или переписал какую-то другую часть в asm). Идеально подходит для фонового обслуживания.

Для обработки фонового сервиса существует модуль SQLite3Service.pas , который отлично работает с LVCL. Это более высокий уровень, чем прямой вызов API.

Вот прекрасно работающая программа фонового обслуживания:

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

Вы можете задать дополнительные вопросы на нашем форуме , если хотите.

Answer 4

Вы всегда можете использовать шаблон службы Visual Studio для создания небольшого хоста службы, который вызывает ваш код Delphi, скомпилированный в DLL.Немного неопрятный, но, вероятно, самый простой способ сократить размер, начиная с того места, где вы находитесь.Простой сервис «ничего не делать» - это 91 КБ, использующий статическое связывание, или 36 КБ с динамическим связыванием со средой выполнения C.