16

サービスとVCLフォームアプリケーション（win32アプリケーション）の両方で使用されるコードがあります。基盤となるアプリケーションがNTサービスとして実行されているのか、アプリケーションとして実行されているのかを判断するにはどうすればよいですか？

ありがとう。

4

12 に答える 12

11

編集開始

これはまだ注目を集めているように見えるので、不足している情報と新しい 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;
于 2009-10-14T19:30:11.060 に答える
10

フォーム ベースのアプリケーションでない場合、アプリケーション オブジェクト (Forms.application) メインフォームは nil になります。

uses
  Forms, ... ;

function IsFormBased : boolean;
begin
  Result := Assigned(Forms.Application.MainForm);
end;
于 2009-10-14T15:37:20.767 に答える
5

GetCurrentProcessIdとのマッチングはどうEnumServicesStatusExですか？
このパラメーターは、構造体lpServicesの配列を受け取るバッファーを指します。ENUM_SERVICE_STATUS_PROCESS照合は、列挙されたサービス プロセス ID: に対して行われますServiceStatusProcess.dwProcessId。

別のオプションは、 を使用してインスタンスWMIを照会することです。Win32_ServiceProcessId=GetCurrentProcessId

于 2012-05-05T13:26:08.623 に答える
5

私はそれを疑います

System.IsConsole
System.IsLibrary

期待される結果が得られます。

私が考えることができるのは、Applicationオブジェクトを TObject としてメソッドに渡し、その区別を行い、渡されたオブジェクトのクラス名が

TServiceApplication 
or
TApplication

とはいえ、コードがサービスで実行されているのか GUI で実行されているのかを知る必要はありません。おそらく設計を再考し、表示したい (または表示したくない) メッセージを処理するオブジェクトを呼び出し元に渡すようにする必要があります。（知りたいメッセージ/例外を表示するためだと思います）。

于 2009-10-14T15:20:39.957 に答える
4

このようなものを試すことができます

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;
于 2009-10-14T15:23:41.090 に答える
3

少なくともForms Application オブジェクトとSvcMgr Application オブジェクトを区別できる場合、1 つのプロジェクトでサービスとフォーム アプリケーションの両方を兼ねることはできません (理想的にはそうではありません)。おそらく、フォーム用に個別のプロジェクトが必要です。コードとサービス コード。

したがって、おそらく最も簡単な解決策は、プロジェクトの条件定義です。つまり、サービス プロジェクトのプロジェクト設定で、Conditional Defines に「 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 をサービスとして実行したいが、ソース コードを変更して「適切な」サービスに変換する方法がない場合にのみ使用される手法です。

于 2009-10-14T19:58:20.340 に答える
2

GetStdHandleメソッドを使用してコンソールハンドルを取得できます。Windowsサービスとして実行されているアプリケーションがコンソールを出力していない場合。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.
于 2012-05-05T11:14:49.360 に答える
2

「ランナー」（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 アプリなど) でも機能します。

于 2014-05-02T10:01:01.573 に答える
1

私は実際にapplication.showmainform変数をチェックすることになりました。

skamradt の isFormBased の問題は、このコードの一部がメイン フォームが作成される前に呼び出されることです。

aldyn-software の SvCom_NTService というソフトウェア ライブラリを使用しています。目的の 1 つはエラーのためです。それらをログに記録するか、メッセージを表示します。@Robに完全に同意します。私たちのコードはよりよく維持され、関数の外でこれを処理する必要があります。

もう 1 つの意図は、データベース接続とクエリの失敗です。関数には、クエリを開くためのさまざまなロジックがあります。サービスの場合は nil を返しますが、プロセスを続行します。しかし、アプリケーションでクエリ/接続の失敗が発生した場合、メッセージを表示してアプリケーションを停止したいと考えています。

于 2009-10-14T16:13:42.580 に答える