確定是否運行爲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」則