Delphi - Beschreibung eines Dienstes ermitteln

(*
 * Author  : http://www.michael-puff.de
 * Date    : 2006-10-25
 * License : PUBLIC DOMAIN
 *)

program Project2; 

{$APPTYPE CONSOLE} 

uses 
  Windows, 
  WinSvc; 

type 
  SERVICE_DESCRIPTION = packed record 
    lpDescription: PWChar; 
  end; 
  PSERVICE_DESCRIPTION = ^SERVICE_DESCRIPTION; 

function QueryServiceConfig2(hService: THandle; dwInfoLevel: DWORD; lpBuffer: Pointer; cbBufSize: DWORD; var 
  pcbBytesNeeded: DWORD): LongBool; stdcall; external 'advapi32.dll' name 'QueryServiceConfig2W'; 

//////////////////////////////////////////////////////////////////////////////// 
// Procedure : SysErrorMessage 
// Comment   : Returns last error as formated string 

function SysErrorMessage(ErrorCode: Integer): string; 
var 
  Len               : Integer; 
  Buffer            : array[0..255] of Char; 
begin 
  Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or 
    FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer, 
    SizeOf(Buffer), nil); 
  while (Len > 0) and (Buffer[Len - 1] in [#0..#32, '.']) do 
    Dec(Len); 
  SetString(Result, Buffer, Len); 
end; 

function GetServiceDesciption(Computer, Servicename: PWChar; var Description: WideString): Boolean; 
var 
  sc                : THandle; 
  os                : THandle; 
  sd                : Boolean; 
  dwNeeded          : DWORD; 
  Buffer            : Pointer; 
begin 
  dwNeeded := 0; 
  Buffer := nil; 
  sc := OpenSCManagerW(Computer, nil, SC_MANAGER_CONNECT); 
  if sc <> 0 then 
  begin 
    os := OpenServiceW(sc, Servicename, SERVICE_QUERY_CONFIG); 
    if os <> 0 then 
    begin 
      sd := QueryServiceConfig2(os, 1, nil, 0, dwNeeded); 
      if (not sd) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then 
      begin 
        try 
          GetMem(Buffer, dwNeeded); 
          result := QueryServiceConfig2(os, 1, Buffer, dwNeeded, dwNeeded); 
          if result then 
          begin 
            Description := PSERVICE_DESCRIPTION(Buffer)^.lpDescription; 
          end; 
        finally 
          FreeMem(Buffer, dwNeeded); 
        end; 
      end 
      else 
        result := False; 
    end 
    else 
      result := False; 
  end 
  else 
    result := False; 
end; 

var 
  description       : WideString; 

begin 
  if not GetServiceDesciption('hal9000', 'NetLogon', description) then 
  begin 
    Writeln(SysErrorMessage(GetLastError)); 
    Readln; 
  end 
  else 
    MessageBoxW(0, PWideChar(description), 'Dienstbeschreibung', 0); 
end.

2012-01-26T23:14:47 +0100, mail[at]michael[Bindestrich]puff.de