一个独立的 Delphi 应用程序，也可以作为 Windows 服务安装

Posted 2023-03-05

【中文标题】一个独立的 Delphi 应用程序，也可以作为 Windows 服务安装

【英文标题】：A standalone Delphi application that can also be installed as windows service

【发布时间】：2010-03-05 14:30:02

【问题描述】：

在 Delphi 中，您可以创建一个独立的 Windows VCL Forms 应用程序。您还可以创建 Windows 服务应用程序。

是否可以将两者结合在一个应用程序中，既可以作为独立应用程序运行，也可以作为 Windows 服务安装？

【参考方案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 可以达到完全相同的效果。

多年前，我为 The Delphi Magazine 写了一篇关于此的文章。你可以在这里阅读：Many Faces Of An Application。

【讨论】：

是否可以创建一个$DEFINE 全局编译来识别它是在独立模式还是Windows服务模式下运行？

【参考方案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.

【参考方案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”参数（也在提升的命令提示符上）。

【参考方案4】：

无需编写任何代码即可解决此问题。这在一定程度上取决于您的应用程序，但通常是可以实现的。试试这个：http://iain.cx/src/nssm。在将应用程序作为服务启动之前，不要忘记启动应用程序所依赖的所有服务。谷歌搜索有关如何做到这一点的信息。

【参考方案5】：

这是可能的，但在这种情况下你不能使用正常的 TServiceApplication 和 TService。您应该自己实现所有服务特定的代码。

我们遇到了一个类似的问题并制作了两个框架应用程序：一个用于单独的沙子 exe，一个用于服务。现在我们可以创建一个嵌入到两个容器中的 BPL/DLL。

如果你想花点钱：你应该看看SvCOM，我认为他们有解决问题的办法。