this slowpoke moves

Get Service Description

uses ExtCtrls, 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';

//

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;

// Beispiel :
procedure TForm1.Button1Click(Sender: TObject);
var 
  description       : WideString;

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

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate