ところがこれらの情報の中にはサービスを起動したときのコマンドラインなどが含まれていません。そこで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さんの回答)。
0 件のコメント:
コメントを投稿