Автономное приложение Delphi, которое также можно установить как службу Windows.

Question

В Delphi вы можете создать отдельное приложение Windows VCL Forms. Вы также можете создать приложение-службу Windows.

Можно ли объединить два приложения в одно приложение, которое может работать как отдельное приложение, а также может быть установлено как служба Windows?

Answer 1

Вполне возможно. Хитрость заключается в том, чтобы отредактировать .dpr для создания главной формы, когда вы хотите запустить как приложение, и формы службы, когда вы хотите запустить как службу. Как это:

if SvComFindCommand('config') then begin
  //When run with the /config switch, display the configuration dialog.
  Forms.Application.Initialize;
  Forms.Application.CreateForm(TfrmConfig, frmConfig);
  Forms.Application.Run;
end
else begin
  SvCom_NTService.Application.Initialize;
  SvCom_NTService.Application.CreateForm(TscmServiceSvc, scmServiceSvc);
  SvCom_NTService.Application.Run;
end;

Приведенный выше код использует SvCom для запуска службы, но тот же эффект может быть достигнут при использовании стандартного TService.

Я написал статью об этом для журнала Delphi много лет назад. Вы можете прочитать это здесь: Многоликая заявка .

Answer 2

Это будет сложно объяснить, но я постараюсь:)

Я сделал это в своем проекте следующим образом (Delphi 5):

program TestSvc;
uses SvcMgr, 
     SvcMain, //the unit for TTestService inherited from TService
     ...
     ;

var
  IsDesktopMode : Boolean;

function IsServiceRunning : Boolean;
var
  Svc: Integer;
  SvcMgr: Integer;
  ServSt : TServiceStatus;
begin
  Result := False;
  SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
  if SvcMgr = 0 then Exit;
  try
    Svc := OpenService(SvcMgr, 'TestService', SERVICE_QUERY_STATUS);
    if Svc = 0 then Exit;
    try
      if not QueryServiceStatus(Svc, ServSt) then Exit;
      Result := (ServSt.dwCurrentState = SERVICE_RUNNING) or (ServSt.dwCurrentState = SERVICE_START_PENDING);
    finally
      CloseServiceHandle(Svc);
    end;
  finally
    CloseServiceHandle(SvcMgr);
  end;
end;


begin
  if (Win32Platform <> VER_PLATFORM_WIN32_NT) or FindCmdLineSwitch('S', ['-', '/'], True)  then
    IsDesktopMode := True
  else begin
    IsDesktopMode := not FindCmdLineSwitch('INSTALL', ['-', '/'], True) and
      not FindCmdLineSwitch('UNINSTALL', ['-', '/'], True) and
      not IsServiceRunning;
  end;

  if IsDesktopMode then begin //desktop mode
    Forms.Application.Initialize;
    Forms.Application.Title := 'App. Title';
    ShowTrayIcon(Forms.Application.Icon.Handle, NIM_ADD); // This function for create an icon to tray. You can create a popupmenu for the Icon.

    while GetMessage(Msg, 0, 0, 0) do begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;

    ShowTrayIcon(Forms.Application.Icon.Handle, NIM_DELETE); // for delete the tray Icon
  end else begin // Service mode
    SvcMgr.Application.Initialize;
    SvcMgr.Application.CreateForm(TTestService, TestService);
    SvcMgr.Application.Run;
  end;
end.

Answer 3

Еще один почти простой вариант доступен по адресу http://cc.embarcadero.com/item/19703,, вам просто нужно включить юнит и изменить свой DPR на что-то вроде:

begin
  if CiaStartService('SERVICE NAME') then begin
    CiaService.CreateForm(TMain, Main);
    CiaService.Run;
    Exit;
  end;

  Application.Initialize;
  Application.Title := 'SERVICE NAME';
  Application.CreateForm(TMain, Main);
  Application.Run;
end.

Хотя этот пример уже устарел, методика достаточно проста, чтобы работать, даже с Delphi XE2. После этого ваше приложение будет продолжать работать как не обслуживаемое до тех пор, пока вы не используете параметр « / install » (в командной строке с повышенными привилегиями). После чего он будет работать как служба, пока не будет использован параметр « / uninstall » (также в командной строке с повышенными привилегиями).

Answer 4

Существует решение этой проблемы без написания ни одной строки кода. Это немного зависит от вашего приложения, но в целом это достижимо. Попробуйте это: http://iain.cx/src/nssm. Не забудьте запустить все службы, от которых зависит ваше приложение, ДО того, как вы запустите свое приложение как службу. Поищите в Google информацию о том, как это сделать.

Answer 5

Это возможно, но в этом случае вы не можете использовать обычные TServiceApplication и TService. Вы должны реализовать весь код, специфичный для службы, самостоятельно.

У нас возникла проблема с similat, и мы сделали два каркасных приложения: одно для песочного exe-файла и одно для службы. Теперь мы можем создать один BPL / DLL, который встроен в оба контейнера.

Если вы хотите потратить немного денег: вы должны посмотреть на SvCOM, я думаю, у них есть решение проблемы.