2010年7月22日

サービスに関する情報を列挙する

インストールされているサービスを取得するにはまずOpenSCManager(ja)でサービスコントロールマネージャをオープンし、EnumServicesStatus(ja)でサービスの情報を取得し、最後にCloseServiceHandle(ja)でサービスコントロールマネージャをクローズします。EnumServicesStatusはサイズを0として呼び出すことで必要な領域の大きさを取得し、領域を確保後に改めてEnumServicesStatusを呼び出します。取得した情報はENUM_SERVICE_STATUS構造体の配列と、そのメンバであるSERVICE_STATUS構造体に格納されます。
ところがこれらの情報の中にはサービスを起動したときのコマンドラインなどが含まれていません。そこでEnumServicesStatusで取得したそれぞれのサービス名についてOpenService(ja)でサービスをオープンし、QueryServiceConfig(ja)でサービスの構成パラメータを取得し、最後にCloseServiceHandleでサービスをクローズします。QueryServiceConfigもまずサイズを0として呼び出して必要な領域のサイズを取得し、領域を確保後に改めてQueryServiceConfigを呼び出します。取得した情報はQUERY_SERVICE_CONFIG構造体に格納されます。
必要な定義は概ねWinSvcユニットに存在しますが、EnumServicesStatusで取得するTEnumServiceStatus(=ENUM_SERVICE_STATUS構造体)の配列へのポインタの型はそのままでは扱いにくいので、
uses
  Windows, SysUtils, WinSvc;

type
  TEnumServiceStatusArray = array [0..0] of TEnumServiceStatus;
  PEnumServiceStatusArray = ^TEnumServiceStatusArray;

{ Alias }
function EnumServicesStatus(hSCManager: SC_HANDLE; dwServiceType: DWORD;
                            dwServiceState: DWORD;
                            lpServices: PEnumServiceStatusArray; cbBufSize: DWORD;
                            var pcbBytesNeeded: DWORD;
                            var lpServicesReturned: DWORD;
                            var lpResumeHandle: DWORD): BOOL; stdcall;
  external advapi32 name
{$IFDEF Unicode}
    'EnumServicesStatusW';
{$ELSE}
    'EnumServicesStatusA';
{$ENDIF}
  {$EXTERNALSYM EnumServicesStatus}
と再定義しておきます。そして
type
  TEnumServicesFunc = function (const ServiceName: String;
                                const DisplayName: String;
                                ServiceStatus: TServiceStatus;
                                const CommandLine: String;
                                Data: Pointer): Boolean;

procedure EnumServices(Func: TEnumServicesFunc; Data: Pointer);
var
  hSCManager: SC_HANDLE;
  RetVal: Boolean;
  BytesNeeded: DWORD;
  ServicesReturned: DWORD;
  ResumeHandle: DWORD;
  PServiceStatus: PEnumServiceStatusArray;
  hService: SC_HANDLE;
  PServiceConfig: Pointer;
  Index: Integer;
  ServiceName: String;
  DisplayName: String;
  ServiceStatus: TServiceStatus;
  CommandLine: String;
begin

  { Open service manager }
  hSCManager := OpenSCManager(nil,nil,SC_MANAGER_ENUMERATE_SERVICE);
  if hSCManager = 0 then
  begin
    RaiseLastOSError;
  end;

  PServiceStatus := nil;
  try
    { Get buffer size }
    BytesNeeded := 0;
    ServicesReturned := 0;
    ResumeHandle := 0;
    RetVal := EnumServicesStatus(hSCManager,SERVICE_WIN32,
                                 SERVICE_STATE_ALL,nil,0,
                                 BytesNeeded,ServicesReturned,ResumeHandle);
    if RetVal = False then
    begin
      { Allocate buffer for EnumServicesStatus }
      PServiceStatus := AllocMem(BytesNeeded);

      { Enumerate service status }
      ResumeHandle := 0;
      RetVal := EnumServicesStatus(hSCManager,SERVICE_WIN32,
                                   SERVICE_STATE_ALL,PServiceStatus,BytesNeeded,
                                   BytesNeeded,ServicesReturned,ResumeHandle);
    end;

    if RetVal = False then
    begin
      RaiseLastOSError;
    end;

    for Index := 0 to ServicesReturned - 1 do
    begin
      ServiceName   := PServiceStatus^[Index].lpServiceName;
      DisplayName   := PServiceStatus^[Index].lpDisplayName;
      ServiceStatus := PServiceStatus^[Index].ServiceStatus;
      CommandLine   := '';

      { Open service for QueryServiceConfig }
      hService := OpenService(hSCManager,PChar(ServiceName),SERVICE_QUERY_CONFIG);
      if hService <> 0 then
      begin
        PServiceConfig := nil;
        try
          { Get buffer size }
          QueryServiceConfig(hService,nil,0,BytesNeeded);

          { Allocate buffer for QueryServiceConfig }
          PServiceConfig := AllocMem(BytesNeeded);

          { Query service configuration }
          if QueryServiceConfig(hService,PServiceConfig,
                                BytesNeeded,BytesNeeded) = True then
          begin
            { Binary pathname }
            CommandLine := TQueryServiceConfig(PServiceConfig^).lpBinaryPathName;
          end;

        finally
          { Close service }
          CloseServiceHandle(hService);

          { Free buffer }
          if PServiceConfig <> nil then
          begin
            FreeMem(PServiceConfig);
          end;
        end;
      end;

      { Callback }
      if Assigned(Func) then
      begin
        if Func(ServiceName,DisplayName,
                ServiceStatus,CommandLine,Data) = False then
        begin
          Break;
        end;
      end;
    end;

  finally
    { Close service manager handle }
    CloseServiceHandle(hSCManager);

    { Free buffer }
    if PServiceStatus <> nil then
    begin
      FreeMem(PServiceStatus);
    end;
  end;

end;
とします。例によってDelphi 2009以降の無名メソッド(anonymous method)を使用する場合は
type
  TEnumServicesFunc = reference to
    function (const ServiceName: String;
              const DisplayName: String;
              ServiceStatus: TServiceStatus;
              const CommandLine: String): Boolean;

procedure EnumServices(Func: TEnumServicesFunc);
var
  hSCManager: SC_HANDLE;
  RetVal: Boolean;
  BytesNeeded: DWORD;
  ServicesReturned: DWORD;
  ResumeHandle: DWORD;
  PServiceStatus: PEnumServiceStatusArray;
  hService: SC_HANDLE;
  PServiceConfig: Pointer;
  Index: Integer;
  ServiceName: String;
  DisplayName: String;
  ServiceStatus: TServiceStatus;
  CommandLine: String;
begin

  { Open service manager }
  hSCManager := OpenSCManager(nil,nil,SC_MANAGER_ENUMERATE_SERVICE);
  if hSCManager = 0 then
  begin
    RaiseLastOSError;
  end;

  PServiceStatus := nil;
  try
    { Get buffer size }
    BytesNeeded := 0;
    ServicesReturned := 0;
    ResumeHandle := 0;
    RetVal := EnumServicesStatus(hSCManager,SERVICE_WIN32,
                                 SERVICE_STATE_ALL,nil,0,
                                 BytesNeeded,ServicesReturned,ResumeHandle);
    if RetVal = False then
    begin
      { Allocate buffer for EnumServicesStatus }
      PServiceStatus := AllocMem(BytesNeeded);

      { Enumerate service status }
      ResumeHandle := 0;
      RetVal := EnumServicesStatus(hSCManager,SERVICE_WIN32,
                                   SERVICE_STATE_ALL,PServiceStatus,BytesNeeded,
                                   BytesNeeded,ServicesReturned,ResumeHandle);
    end;

    if RetVal = False then
    begin
      RaiseLastOSError;
    end;

    for Index := 0 to ServicesReturned - 1 do
    begin
      ServiceName   := PServiceStatus^[Index].lpServiceName;
      DisplayName   := PServiceStatus^[Index].lpDisplayName;
      ServiceStatus := PServiceStatus^[Index].ServiceStatus;
      CommandLine   := '';

      { Open service for QueryServiceConfig }
      hService := OpenService(hSCManager,PChar(ServiceName),SERVICE_QUERY_CONFIG);
      if hService <> 0 then
      begin
        PServiceConfig := nil;
        try
          { Get buffer size }
          QueryServiceConfig(hService,nil,0,BytesNeeded);

          { Allocate buffer for QueryServiceConfig }
          PServiceConfig := AllocMem(BytesNeeded);

          { Query service configuration }
          if QueryServiceConfig(hService,PServiceConfig,
                                BytesNeeded,BytesNeeded) = True then
          begin
            { Binary pathname }
            CommandLine := TQueryServiceConfig(PServiceConfig^).lpBinaryPathName;
          end;

        finally
          { Close service }
          CloseServiceHandle(hService);

          { Free buffer }
          if PServiceConfig <> nil then
          begin
            FreeMem(PServiceConfig);
          end;
        end;
      end;

      { Callback }
      if Assigned(Func) then
      begin
        if Func(ServiceName,DisplayName,
                ServiceStatus,CommandLine) = False then
        begin
          Break;
        end;
      end;
    end;

  finally
    { Close service manager handle }
    CloseServiceHandle(hSCManager);

    { Free buffer }
    if PServiceStatus <> nil then
    begin
      FreeMem(PServiceStatus);
    end;
  end;

end;
こんな感じになります。なお取得したコマンドラインの中にはパス名に空白文字を含むにもかかわらずダブルクォーテーションで括られていないものもあるため、コマンドラインから実行ファイルのフルパス名を取り出すには
uses
  StrUtils;

function CommandlineToPathname(const CommandLine: String): String;
var
  Start: Integer;
  Position: Integer;
begin

  Result := CommandLine;

  if Result = '' then
  begin
    Exit;
  end;

  if Result[1] = '"' then
  begin
    { Quoted }
    Delete(Result,1,1);  // Delete first double quote
{$IFDEF Unicode}
    Position := Pos('"',Result);
{$ELSE}
    Position := AnsiPos('"',Result);
{$ENDIF}
    if Position > 0 then
    begin
      Delete(Result,Position,Length(Result));
    end;
  end
  else
  begin
    { Not quoted }
    Start := 1;
    while True do
    begin
      Position := PosEx(' ',Result,Start);
      if Position = 0 then
      begin
        Break;
      end;

      Start := Position + 1;
{$IFDEF Unicode}
      if CharInSet(Result[Start],['-','/']) then
{$ELSE}
      if Result[Start] in ['-','/'] then
{$ENDIF}
      begin
        Delete(Result,Position,Length(Result));
        Break;
      end;
    end;
  end;

end;
このように一捻り必要です。

元ねたは旧Delphi-MLの90131以下のスレッド(特に90133のKHE00221さんの回答)。
Category: , at 14:00:00

0 件のコメント:

コメントを投稿

登録: コメントの投稿 (Atom)