确定是否作为VCL表单或服务运行

Question

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

谢谢.

Answer 1

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

uses
  Forms, ... ;

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

Answer 2

开始编辑

由于这似乎仍然得到一些关注,我决定更新答案与缺少信息和更新的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;

Answer 3

我不信

System.IsConsole
System.IsLibrary

会给你预期的结果.

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

TServiceApplication 
or
TApplication

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

Answer 4

如何匹配GetCurrentProcessId反对EnumServicesStatusEx？
该lpServices参数指向接收ENUM_SERVICE_STATUS_PROCESS结构数组的缓冲区.匹配是针对枚举的服务进程ID:ServiceStatusProcess.dwProcessId在该结构中完成的.

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

Answer 5

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

skamradt 的 isFormBased 的问题在于，其中一些代码在创建主表单之前被调用。

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

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