delphi - 确定是作为 VCL Forms 还是 Service 运行

Question

我有在服务和 VCL 表单应用程序（win32 应用程序）中使用的代码。如何确定底层应用程序是作为 NT 服务运行还是作为应用程序运行？

谢谢。

score 11 · Accepted Answer

开始编辑

由于这似乎仍然引起了一些关注，我决定用缺少的信息和更新的 Windows 补丁来更新答案。在任何情况下，您都不应该复制/粘贴代码。该代码只是展示应该如何完成的事情。

编辑结束：

您可以检查父进程是否为 SCM（服务控制管理器）。如果您作为服务运行，情况总是如此，如果作为标准应用程序运行，则永远不会出现这种情况。此外，我认为 SCM 始终具有相同的 PID。

您可以像这样检查它：

type
  TAppType = (atUnknown, atDesktop, atService);

var
  AppType: TAppType;

function InternalIsService: Boolean;
var
  PL: TProcessList;
  MyProcessId: DWORD;
  MyProcess: PPROCESSENTRY32;
  ParentProcess: PPROCESSENTRY32;
  GrandParentProcess: PPROCESSENTRY32;
begin
  Result := False;

  PL := TProcessList.Create;
  try
    PL.CreateSnapshot;
    MyProcessId := GetCurrentProcessId;

    MyProcess := PL.FindProcess(MyProcessId);
    if MyProcess <> nil then
    begin
      ParentProcess := PL.FindProcess(MyProcess^.th32ParentProcessID);
      if ParentProcess <> nil then
      begin
        GrandParentProcess := PL.FindProcess(ParentProcess^.th32ParentProcessID);

        if GrandParentProcess <> nil then
        begin
          Result := SameText(string(ParentProcess^.szExeFile), 'services.exe') and
            (SameText(string(GrandParentProcess^.szExeFile), 'winlogon.exe') or
             SameText(string(GrandParentProcess^.szExeFile), 'wininit.exe'));
        end;
      end;
    end;
  finally
    PL.Free;
  end; 
end;

function IsService: Boolean;
begin
  if AppType = atUnknown then
  begin
    try
      if InternalIsService then
        AppType := atService
      else
        AppType := atDesktop;
    except
      AppType := atService;
    end;
  end;

  Result := AppType = atService;
end;

initialization
  AppType := atUnknown;

TProcessList 是这样实现的（同样不包括 THashTable，但任何哈希表都应该没问题）：

type
  TProcessEntryList = class(TList)
  private
    function Get(Index: Integer): PPROCESSENTRY32;
    procedure Put(Index: Integer; const Value: PPROCESSENTRY32);
  public
    property Items[Index: Integer]: PPROCESSENTRY32 read Get write Put; default;
    function Add(const Entry: TProcessEntry32): Integer; reintroduce;
    procedure Clear; override;
  end;

  TProcessList = class
  private
    ProcessIdHashTable: THashTable;
    ProcessEntryList: TProcessEntryList;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
    procedure CreateSnapshot;
    function FindProcess(const ProcessId: DWORD): PPROCESSENTRY32;
  end;

implementation

{ TProcessEntryList }

procedure TProcessEntryList.Clear;
var
  i: Integer;
begin
  i := 0;
  while i < Count do
  begin
    FreeMem(Items[i]);
    Inc(i);
  end;

  inherited;
end;

procedure TProcessEntryList.Put(Index: Integer; const Value: PPROCESSENTRY32);
var
  Item: Pointer;
begin
  Item := inherited Get(Index);
  CopyMemory(Item, Value, SizeOf(tagPROCESSENTRY32));
end;

function TProcessEntryList.Get(Index: Integer): PPROCESSENTRY32;
begin
  Result := PPROCESSENTRY32(inherited Get(Index));
end;

function TProcessEntryList.Add(const Entry: TProcessEntry32): Integer;
var
  EntryCopy: PPROCESSENTRY32;
begin
  GetMem(EntryCopy, SizeOf(tagPROCESSENTRY32));
  CopyMemory(EntryCopy, @Entry, SizeOf(tagPROCESSENTRY32));

  Result := inherited Add(EntryCopy);  
end;

{ TProcessList }

constructor TProcessList.Create;
begin
  inherited;

  ProcessEntryList := TProcessEntryList.Create;
  ProcessIdHashTable := THashTable.Create;
end;

destructor TProcessList.Destroy;
begin
  FreeAndNil(ProcessIdHashTable);
  FreeAndNil(ProcessEntryList);

  inherited;
end;

function TProcessList.FindProcess(const ProcessId: DWORD): PPROCESSENTRY32;
var
  ItemIndex: Integer;
begin
  Result := nil;
  if not ProcessIdHashTable.ContainsKey(IntToStr(ProcessId)) then
    Exit;

  ItemIndex := Integer(ProcessIdHashTable.Item[IntToStr(ProcessId)]);
  Result := ProcessEntryList.Items[ItemIndex];
end;

procedure TProcessList.CreateSnapshot;
var
  SnapShot: THandle;
  ProcessEntry: TProcessEntry32;
  ItemIndex: Integer;
begin
  SnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if SnapShot <> 0 then
  try
    ProcessEntry.dwSize := SizeOf(ProcessEntry);
    if Process32First(SnapShot, ProcessEntry) then
    repeat
      ItemIndex := ProcessEntryList.Add(ProcessEntry);
      ProcessIdHashTable.Add(IntToStr(ProcessEntry.th32ProcessID), TObject(ItemIndex));
    until not Process32Next(SnapShot, ProcessEntry);
  finally
    CloseHandle(SnapShot);
  end;
end;

score 10 · Accepted Answer

如果不是基于表单的应用程序，应用程序对象 (Forms.application) mainform 将为 nil。

uses
  Forms, ... ;

function IsFormBased : boolean;
begin
  Result := Assigned(Forms.Application.MainForm);
end;

score 5 · Accepted Answer

我不信

System.IsConsole
System.IsLibrary

会给你预期的结果。

我能想到的就是将Application对象作为 TObject 传递给您需要进行区分的方法，并测试传递的对象的类名是否为

TServiceApplication 
or
TApplication

也就是说，您不需要知道您的代码是在服务中运行还是在 GUI 中运行。您可能应该重新考虑您的设计并让调用者传递一个对象来处理您想要（或不想要）显示的消息。（我假设它是用于显示您想知道的消息/异常）。

score 5 · Accepted Answer

怎么GetCurrentProcessId匹配EnumServicesStatusEx？
该lpServices参数指向一个接收结构数组的缓冲区ENUM_SERVICE_STATUS_PROCESS。匹配是针对枚举的服务进程 ID：ServiceStatusProcess.dwProcessId在该结构中完成的。

另一种选择是WMI用于查询Win32_Service实例 where ProcessId=GetCurrentProcessId。

score 4 · Accepted Answer

你可以试试这样的

Function IsMyformInsideaWindowsService(aForm:TObject) :Boolean;
Begin
   Result:=aForm.ClassParent.ClassName='TService';  //When a form is running under a service the Class Parent is a TService
End;

score 3 · Accepted Answer

单个项目不能（或者我应该说理想情况下不是）服务和表单应用程序，至少如果您能够区分Forms Application 对象和SvcMgr Application 对象，则不能 - 您可能必须有单独的表单项目代码和服务代码。

所以也许最简单的解决方案是项目条件定义。即在服务项目的项目设置中，将“ SERVICEAPP ”添加到条件定义中。

然后，每当您需要简单地改变行为时：

{$ifdef SERVICEAPP}
{$else}
{$endif}

对于皮带和大括号，您可能会在某些启动代码中采用前面描述的测试之一，以确保您的项目已使用定义的预期符号进行编译。

program ... ;

 :

begin
{$ifdef SERVICEAPP}
  // test for service app - ASSERT if not
{$else}
  // test for forms app - ASSERT if not
{$endif}
  :
end.

您的Forms应用程序可能实际上作为服务运行，使用允许任何应用程序作为服务运行的粗略技术。

当然，在这种情况下，您的应用程序将始终是Forms应用程序，处理这种情况的最简单方法是使用您仅在可执行文件的服务定义中指定的命令行开关，以便您的应用程序可以通过测试做出适当的响应命令行开关。

当然，这确实允许您更轻松地测试您的“服务模式”行为，因为您可以使用从 IDE 中定义的开关在“调试”模式下运行您的应用程序，但这不是构建服务应用程序的理想方式，所以我不会仅凭这一点推荐它。这种技术通常仅在您希望将 EXE 作为服务运行但无法修改源代码以将其转换为“适当的”服务时使用。

score 2 · Accepted Answer

您可以使用 GetStdHandle 方法获取控制台句柄。当应用程序作为 Windows 服务运行时没有输出控制台。如果 GetStdHandle 等于 0 表示您的应用程序作为 Windows 服务运行。

{$APPTYPE CONSOLE} // important

uses
   uServerForm in 'uServerForm.pas' {ServerForm},
 uWinService in 'uWinService.pas' {mofidWinServer: TService},

  Windows,
  System.SysUtils,
  WinSvc,
  SvcMgr,
  Forms,etc;
function RunAsWinService: Boolean;
var
  H: THandle;
begin
  if FindCmdLineSwitch('install', ['-', '/'], True) then
    Exit(True);
  if FindCmdLineSwitch('uninstall', ['-', '/'], True) then
    Exit(True);
  H := GetStdHandle(STD_OUTPUT_HANDLE);
  Result := H = 0;
end;


begin       
  if RunAsWinService then
  begin

    SvcMgr.Application.Initialize;
    SvcMgr.Application.CreateForm(TmofidWinServer, mofidWinServer);
    SvcMgr.Application.Run;
  end
  else
  begin
    Forms.Application.Initialize;
    Forms.Application.CreateForm(TServerForm, ServerForm);
    Forms.Application.Run;
  end;
end.

score 2 · Accepted Answer

“Runner”（https://stackoverflow.com/a/1568462）的答案看起来很有帮助，但我无法使用它，因为既没有定义 TProcessList 也没有定义 CreateSnapshot。在 Google 中搜索“TProcessList CreateSnapshot”只会找到 7 页，包括这一页和该页的镜像/引用。不存在代码。唉，我的名声太低了，不能给他发评论，问我在哪里可以找到TProcessList的代码。

另一个问题：在我的电脑（Win7 x64）上，“services.exe”不在“winlogon.exe”中。它在“wininit.exe”里面。由于它似乎是 Windows 的实现细节，我建议不要查询祖父母。此外，services.exe 不需要是直接父级，因为可以派生进程。

所以这是我直接使用 TlHelp32 的版本，解决了所有问题：

uses
  Classes, TlHelp32;

function IsRunningAsService: boolean;

  function FindProcess(FSnapshotHandle: THandle; PID: DWORD; var lppe: TProcessEntry32): boolean;
  var
    ContinueLoop: BOOL;
  begin
    ContinueLoop := Process32First(FSnapshotHandle, lppe);
    while Integer(ContinueLoop) <> 0 do
    begin
      if lppe.th32ProcessID = PID then
      begin
        result := true;
        Exit;
      end;
      ContinueLoop := Process32Next(FSnapshotHandle, lppe);
    end;
    result := false;
  end;

var
  CurProcessId: DWORD;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
  ExeName, PrevExeName: string;
  DeadlockProtection: TList<Integer>;
begin
  Result := false;

  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
    CurProcessId := GetCurrentProcessId;
    FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
    ExeName := '';
    while FindProcess(FSnapshotHandle, CurProcessId, FProcessEntry32) do
    begin
      if DeadlockProtection.IndexOf(FProcessEntry32.th32ProcessID) > -1 then break;
      DeadlockProtection.Add(FProcessEntry32.th32ProcessID);

      PrevExeName := ExeName;
      ExeName     := FProcessEntry32.szExeFile;

      (*
      Result := SameText(PrevExeName, 'services.exe') and // Parent
                SameText(ExeName,     'winlogon.exe');    // Grandparent
      *)

      Result := SameText(ExeName, 'services.exe'); // Parent

      if Result then Exit;

      CurProcessId := FProcessEntry32.th32ParentProcessID;
    end;
  finally
    CloseHandle(FSnapshotHandle);
    DeadlockProtection.Free;
  end;
end;

此代码有效，即使在没有 MainForm 的应用程序（例如 CLI 应用程序）中也是如此。

score 1 · Accepted Answer

我实际上最终检查了application.showmainform变量。

skamradt 的 isFormBased 的问题是在创建主窗体之前调用了其中的一些代码。

我正在使用来自 aldyn-software 的名为 SvCom_NTService 的软件库。目的之一是为了错误；记录它们或显示消息。我完全同意@Rob；我们的代码应该得到更好的维护，并在函数之外处理这个问题。

另一个目的是用于失败的数据库连接和查询；我的函数中有不同的逻辑来打开查询。如果它是一个服务，那么它将返回 nil 但继续该过程。但是，如果应用程序中发生失败的查询/连接，那么我想显示一条消息并停止应用程序。

score 1 · Accepted Answer

我没有找到可以轻松使用且不需要重新编译并允许将一个 exe 用作服务和应用程序的简单答案。您可以使用命令行参数（如“...\myapp.exe –s”）将程序安装为服务，然后从程序中进行检查：

如果 ParamStr(ParamCount) = '-s' 那么

score 1 · Accepted Answer

您可以根据检查当前进程的会话 ID 进行检查。所有服务都以会话 ID = 0 运行。

function IsServiceProcess: Boolean;
var
  LSessionID, LSize: Cardinal;
  LToken: THandle;
begin
  Result := False;
  LSize := 0;
  if not OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, LToken) then
    Exit;

  try
    if not GetTokenInformation(LToken, TokenSessionId, @LSessionID, SizeOf(LSessionID), LSize) then
      Exit;

    if LSize = 0 then
      Exit;

    Result := LSessionID = 0;
  finally
    CloseHandle(LToken);
  end;
end;

score 0 · Accepted Answer

检查您的 Applicatoin 是否是 TServiceApplication 的实例：

IsServiceApp := Application is TServiceApplication;

delphi - 确定是作为 VCL Forms 还是 Service 运行

12 回答 12

Related

Reference