Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi QueryServiceConfig2 (PointerProb) (https://www.delphipraxis.net/79412-queryserviceconfig2-pointerprob.html)

Harry M. 21. Okt 2006 23:32


QueryServiceConfig2 (PointerProb)
 
Nabend...

ich versuche gerade an die Beschreibung eines Services zu kommen.... aba leider stimmt da was noch ganz im Code mit den Pointern. Ich kriegs aber leider allein noch net hin :pale:

Delphi-Quellcode:
type
  TServicesDesciption = record
    lpDescription: PChar;
    end;
  PServicesDesciption = ^PServicesDesciption;


function QueryServiceConfig2(
  hService: SC_HANDLE;
  dwInfoLevel: DWORD;
  lpBuffer: PBYTE;
  cbBufSize: DWORD;
  pcbBytesNeeded: LPDWORD): LongBool;

  function QueryServiceConfig2; external Windows.advapi32 name 'QueryServiceConfig2A'; //Ansi
  //function QueryServiceConfig2; external Windows.advapi32 name 'QueryServiceConfig2W'; //Uni

function GetServiceDescription(AServicename: PChar): String;
Const
  SERVICE_CONFIG_DESCRIPTION = 1;
var
  MgrHWND, SvcHWND: SC_Handle;
  ServiceDesciption: PServicesDesciption;
  cbBufSize: DWORD;
  pcbBytesNeeded: LPDWORD;
begin
  MgrHWND := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);

  if MgrHWND > 0 then begin
    SvcHWND := WinSvc.OpenService(MgrHWND, AServicename, SERVICE_QUERY_CONFIG);

    if SvcHWND > 0 then begin
      cbBufSize := 512;
      pcbBytesNeeded := nil;
      GetMem(ServiceDesciption, cbBufSize);

      if QueryServiceConfig2(SvcHWND, SERVICE_CONFIG_DESCRIPTION, @ServiceDesciption, cbBufSize, @pcbBytesNeeded) then
        Result := ^PServiceDesciption.lpDescription // was stimmt hier noch nicht??
        else
        Result := SysErrorMessage(GetLastError);

        end;

    CloseServiceHandle(SvcHWND);
    end;

  CloseServiceHandle(MgrHWND);
end;
Mehr Info zu QueryServiceConfig2:
http://msdn.microsoft.com/library/de...iceconfig2.asp

Christian Seehase 22. Okt 2006 00:09

Re: QueryServiceConfig2 (PointerProb)
 
Moin Harry,

was schon einmal falsch ist:
Du deklarierst einen Typen TServicesDescription und anschliessend PServicesDesciption = ^PServicesDesciption;

Die Problemzeile müsste lauten:

Delphi-Quellcode:
Result := ServiceDesciption.lpDescription // was stimmt hier noch nicht??
Ich für meinen Teil halte mich bei der Deklaration von API-Strukturen lieber an die Namen im PSDK, damit ich bei Dokumenationen / Beispielen, nicht lange suchen muss wie ich denn nun die Struktur genannt habe.

In Deinem Falle:

Delphi-Quellcode:
type
  SERVICE_DESCRIPTION = packed record
    lpDescription : PChar;
  end;
  PSERVICE_DESCRIPTION = ^SERVICE_DESCRIPTION;
Ausserdem deklariere ich lieber alle Parameter eine API-Funktion als const um sicherzugehen, dass ich die Parameter auch so verwende wie gedacht. Vor allem bei out-Parametern finde ich das besser als die Borland-typischen var-Parameter, da man manche Funktionalität mit var-Parametern gar nicht nutzen kann, und die Funktion dann erneut importieren muss.
Zudem finde ich es so einfacher Beispiele zu übersetzen.

Harry M. 22. Okt 2006 00:31

Re: QueryServiceConfig2 (PointerProb)
 
Ah jetzt weiß ich auch warum ich Deklarationen finde im Source von Anderen, obwohl die entsprechne Units eingebunden ist....

Also ich habe mal die 2 Zeilen geändert... Ich bekomme jetzt nur SpeicherSalat (AV an Adressee 0x00000000)

Christian Seehase 22. Okt 2006 01:03

Re: QueryServiceConfig2 (PointerProb)
 
Moin Harry,

wenn ich mal meine Deklaration voraussetze, müssten die zu ändernden Zeilen so aussehen:

Delphi-Quellcode:
ServiceDescription : PSERVICE_DESCRIPTION;

// und

Result := ServiceDescription.lpDescription
Zu Deinem GetMem fehlt übrigens noch ein FreeMem.
Resourcen die man belegt, muss man auch immer wieder freigeben.

Harry M. 22. Okt 2006 10:34

Re: QueryServiceConfig2 (PointerProb)
 
Hallo Christian Seehase...

habe das FreeMem gestern noch eingefügt, war mir selbst aufgefallen :)
Mit FreeMem er folgt eine Ungültige Zeigeroperation und ohne eine AV 0x00000000

Hier nochmal der Code in seiner "aktuellen Fassung"

Delphi-Quellcode:
function GetServiceDescription(AServicename: PChar): String;
Const
  SERVICE_CONFIG_DESCRIPTION = 1;
var
  MgrHWND, SvcHWND: SC_Handle;
  ServiceDesciption: PSERVICE_DESCRIPTION;
  cbBufSize: DWORD;
  pcbBytesNeeded: LPDWORD;
begin
  MgrHWND := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);

  if MgrHWND > 0 then begin
    SvcHWND := WinSvc.OpenService(MgrHWND, AServicename, SERVICE_QUERY_CONFIG);

    if SvcHWND > 0 then begin
      cbBufSize := 512;
      pcbBytesNeeded := nil;
      GetMem(ServiceDesciption, cbBufSize);

      if QueryServiceConfig2(SvcHWND, SERVICE_CONFIG_DESCRIPTION, @ServiceDesciption, cbBufSize, @pcbBytesNeeded) then
        Result := ServiceDesciption.lpDescription // das kann ich problemslos compilieren jetzt
        else
        Result := SysErrorMessage(GetLastError);

      FreeMem(ServiceDesciption);
      end;

    CloseServiceHandle(SvcHWND);
    end;

  CloseServiceHandle(MgrHWND);
end;
Und ein 2. Versuch der auch nicht recht glückte....

Delphi-Quellcode:
function QueryServiceConfig2A(hService: SC_HANDLE; dwInfoLevel: DWORD; lpBuffer: PBYTE;
  cbBufSize: DWORD; pcbBytesNeeded: LPDWORD): LongBool; stdcall;
type
  TServiceDescription = function(hService: SC_HANDLE; dwInfoLevel: DWORD; lpBuffer: PBYTE;
                                cbBufSize: DWORD; pcbBytesNeeded: LPDWORD): LongBool; stdcall;
var
  LLibHandle: THandle;
  LPtr: Pointer;
  ServiceDesciption: TServiceDescription;
begin
  LLibHandle:=LoadLibrary('advapi32.dll');
  LPtr := GetProcAddress(LLibHandle,'QueryServiceConfig2A');
    if LPtr <> nil then begin
      ServiceDesciption := LPtr;
      Result := ServiceDesciption(hService, dwInfoLevel, lpBuffer, cbBufSize, pcbBytesNeeded) // hier stimmt was net :(
      end else
      Result := False;
end;

function GetServiceDesciption2(AServicename: PChar): String;
Const
  SERVICE_CONFIG_DESCRIPTION = 1;
var
  MgrHWND, SvcHWND: SC_Handle;
  ServiceDesciption: PSERVICE_DESCRIPTION;
  cbBufSize: DWORD;
  pcbBytesNeeded: LPDWORD;
begin
  MgrHWND := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);

  if MgrHWND > 0 then begin
    SvcHWND := WinSvc.OpenService(MgrHWND, AServicename, SERVICE_QUERY_CONFIG);

    if SvcHWND > 0 then begin
      cbBufSize := 1024 * 8;
      pcbBytesNeeded := nil;
      GetMem(ServiceDesciption, cbBufSize);

      if QueryServiceConfig2A(SvcHWND, SERVICE_CONFIG_DESCRIPTION, @ServiceDesciption, cbBufSize, @pcbBytesNeeded) then
        Result := ServiceDesciption.lpDescription
        else
        Result := SysErrorMessage( GetLastError );

      FreeMem(ServiceDesciption);
      end;

    end;

  CloseServiceHandle(MgrHWND);
  CloseServiceHandle(SvcHWND);
end;

Harry M. 25. Okt 2006 07:40

Re: QueryServiceConfig2 (gelöst)
 
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.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): WideString;
var
  sc               : THandle;
  os               : THandle;
  sd               : Boolean;
  dwNeeded         : DWORD;
  Buffer           : Pointer;
begin
  result := '';
  dwNeeded := 0;
  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
        GetMem(Buffer, dwNeeded);
        sd := QueryServiceConfig2(os, 1, Buffer, dwNeeded, dwNeeded);
        if sd then
        begin
          result := PSERVICE_DESCRIPTION(Buffer)^.lpDescription;
        end
        else
          Writeln(SysErrorMessage(GetLastError));
      end;
    end
    else
      Writeln(SysErrorMessage(GetLastError));
  end
  else
    Writeln(SysErrorMessage(GetLastError));
end;

var
  description      : WideString;

begin
  description := GetServiceDesciption('hal9000', 'ClipSrv');
  MessageBoxW(0, PWideChar(description), 'Dienstbeschreibung', 0);
end.
Danke Luckie :thumb: :zwinker:

SirThornberry 25. Okt 2006 08:25

Re: QueryServiceConfig2 (PointerProb)
 
Zitat:

Ausserdem deklariere ich lieber alle Parameter eine API-Funktion als const um sicherzugehen, dass ich die Parameter auch so verwende wie gedacht. Vor allem bei out-Parametern finde ich das besser als die Borland-typischen var-Parameter, da man manche Funktionalität mit var-Parametern gar nicht nutzen kann, und die Funktion dann erneut importieren muss.
Zudem finde ich es so einfacher Beispiele zu übersetzen.
was sollte bei Var-Parametern nicht funkionieren was bei const oder Pointern geht? Auch bei Var-Parametern kann man ohne große Probleme nil etc. übergeben.

Muetze1 25. Okt 2006 08:29

Re: QueryServiceConfig2 (PointerProb)
 
Zitat:

Zitat von SirThornberry
Zitat:

Ausserdem deklariere ich lieber alle Parameter eine API-Funktion als const um sicherzugehen, dass ich die Parameter auch so verwende wie gedacht. Vor allem bei out-Parametern finde ich das besser als die Borland-typischen var-Parameter, da man manche Funktionalität mit var-Parametern gar nicht nutzen kann, und die Funktion dann erneut importieren muss.
Zudem finde ich es so einfacher Beispiele zu übersetzen.
was sollte bei Var-Parametern nicht funkionieren was bei const oder Pointern geht? Auch bei Var-Parametern kann man ohne große Probleme nil etc. übergeben.

Seit wann? Bzw. seit welcher Delphi Version? Ein Var Parameter will immer eine Variable haben (zur Compilezeit schon), weil sonst die Zuweisungen innerhalb der Procedure/Funktion/Methode nicht funktionieren. Soll er einer NIL Variable was zuweisen? Das verhindert der Compiler.

Luckie 25. Okt 2006 08:34

Re: QueryServiceConfig2 (PointerProb)
 
Ich sehe gerade, ich habe das FreeMem vergessen und ein try finally Block um das GetMem und FreeMem dürfte auch nicht schaden.

SirThornberry 25. Okt 2006 08:36

Re: QueryServiceConfig2 (PointerProb)
 
Es ist nur der Compiler der meckert weil er eine Variable will. Intern wird bei einem Var- oder Pointer-Parametern das gleiche gemacht. Daher kann man auch einfach ein nil derefenzieren.

Beispiel:
Delphi-Quellcode:
procedure Test(var EinString: String);
begin
  if (@EinString <> nil) then
  begin
    ShowMessage(EinString);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Test(String(nil^));
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 17:54 Uhr.
Seite 1 von 2  1 2      

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz