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

Question

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

谢谢。

Answer 1

其实我结束了检查application.showmainform变量。

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

我正在使用一个名为来自aldyn-software的SvCom_NTService的软件库。其中一个目的是出错;要么登录它们，要么显示消息。我完全同意@Rob;我们的代码应该更好地维护并处理这些功能。

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

Answer 2

我怀疑

System.IsConsole 
System.IsLibrary 

会给你预期的结果。

所有我能想到的是要传递一个应用对象TObject的到你需要为传递的对象的类名是区分和测试是一个

TServiceApplication 
or 
TApplication 

认为方法，不该不需要你知道你的代码是在服务还是GUI中运行。你应该重新考虑你的设计，并让调用者传递一个对象来处理你想要（或不想）显示的消息。 （我假设它是用来显示你想知道的消息/例外）。

Answer 3

你可以尝试这样的事情

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; 

Answer 4

应用对象（Forms.application）的MainForm将是零，如果它不是基于窗体应用程序。

uses 
    Forms, ... ; 

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

Answer 5

编辑

的地开始，因为这似乎仍然得到一些关注，我决定更新缺少信息和更新Windows补丁的答案。无论如何你都不应该复制/粘贴代码。代码仅仅是展示应该如何完成这些事情的展示。编辑的

END：

您可以检查是否父进程是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 6

单个项目不能（或者我应该说非常不）兼具服务和应用形式，至少，如果你能在形式应用对象和SvcMgr申请区分认证对象 - 您必须为表单代码和服务代码建立单独的项目。

因此，也许最简单的解决方案是一个项目，有条件的定义。即在项目设置的服务项目中添加“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. 

这可能是你的形式应用程序实际上是作为服务运行，使用粗糙的技术，它允许任何应用将作为服务运行。

当然，在这种情况下，你的应用程序将总是是形式应用和处理这种情况的最简单的方法是让您只指定在服务定义为您的可执行命令行开关，使您的应用程序可以通过测试该命令行开关来进行适当的响应

这确实可以让你更容易地测试你的“服务模式”行为，因为你可以用IDE中定义的那个开关在“调试”模式下运行你的应用程序，但它不是一个理想的方法来构建服务应用程序，所以我不会仅凭这一点推荐它。这是一种技巧，通常只有在您希望作为服务运行的EXE时才会使用，但无法修改源代码以将其转换为“正确”服务。

Answer 7

您可以使用GetStdHandle方法脱身运行Windows服务控制台handle.when应用程序还没有console.if GetStdHandle输出为零意味着你的应用程序运行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. 

Answer 8

如何匹配GetCurrentProcessId与EnumServicesStatusEx？
的lpServices参数指向接收ENUM_SERVICE_STATUS_PROCESS结构的阵列的缓冲器。在该结构ServiceStatusProcess.dwProcessId： 匹配靠在枚举服务进程ID来完成。

另一种选择是使用WMI来查询Win32_Service其中ProcessId=GetCurrentProcessId的情况。

Answer 9

“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应用程序）。

Answer 10

检查您Applicatoin是TServiceApplication的一个实例：

IsServiceApp := Application is TServiceApplication; 

Answer 11

我没有找到简单的答案可以很容易地使用，并且不需要重新编译，并允许使用一个EXE作为服务和应用。你可以安装你的程序与命令行参数，如“... \ MyApp.exe中-s”的服务，然后从程序检查：

如果ParamStr这（ParamCount）=“-S”则