インストールされているサービスを取得するにはまず
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さんの回答)。
