Создайте небольшую и краткую службу Windows с помощью Delphi

Ответ 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.

EDIT:

Я скомпилировал вышеуказанный код без ресурсов и SysUtils. Я получил исполняемый файл 32 КБ под Delphi XE и 22KB исполняемый файл в Delphi 2006. В XE я удалил информацию RTTI. Я расскажу об этом, потому что это интересно. Я хочу знать, насколько велик исполняемый файл С++.

EDIT2:

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

Ответ 2

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

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

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

Ответ 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.

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

Ответ 4

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