Einzelnen Beitrag anzeigen

Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#11

Re: QueryServiceConfig2 (PointerProb)

  Alt 25. Okt 2006, 10:01
Ich habe es noch etwas schöner gemacht:
Delphi-Quellcode:
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.dllname '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.
Allerdings kann ich es nicht testen, da bei mir der Fehler
Zitat:
Der RPC-Server ist nicht verf³gbar
kommt, was auch immer das bedeutet.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat