GetProcessIoCounters

[Nachaz]

Hallo!

Ich habe ein kleines Problem: Ich will die Windows-Funktion GetProcessIoCounters aus Delphi 6 aufrufen. Die steht aber leider nicht vordefiniert in der Windows.pas (auch nicht in irgend einer anderen). Also hab' ich mir 'ne Funktion gebastelt: (Hier als Mini-Unit zum einbinden für Interessierte)

Delphi-Quellcode:

unit UNIFunctions;

interface
uses Windows, SysUtils, UNIConst, Forms;
type
  TIoCounters = record
    ReadOperationCount  : LONGLONG;
    WriteOperationCount : LONGLONG;
    OtherOperationCount : LONGLONG;
    ReadTransferCount   : LONGLONG;
    WriteTransferCount  : LONGLONG;
    OtherTransferCount  : LONGLONG;
  end;
  PIoCounters = ^TIoCounters;

Function GetProcessIoCounters(hProc : THandle) : PIoCounters;

implementation

Function GetProcessIoCounters(hProc : THandle) : PIoCounters;
var
  pIoc : PIoCounters;
  hDLL : THandle;
  _GetProcessIoCounters : Function(hProc : THandle; var IoCounters : PIoCounters) : BOOL;
begin
  hDll := LoadLibrary('Kernel32.dll');

  if hDll <> 0 then
    begin
       _GetProcessIoCounters := GetProcAddress(hDLL,'GetProcessIoCounters');

       if @_GetProcessIoCounters <> nil then
         begin
//           new(pIoc);
           if _GetProcessIoCounters(hProc, pIoc) then
             begin
//               dispose(@_GetProcessIoCounters);
               result := pioc
             end
           else
             result := nil;

//           Dispose(pIoc);
         end
       else
         result := nil;
      FreeLibrary(hDLL);
    end
  else
    result := nil
end;

end.

Der Aufruf des ganzen sieht so aus: (lvProc ist ein TListView auf dem Formular, ListItems inkl. Subitems sind schon da)

Delphi-Quellcode:

procedure TfrmProcessInfo.refresh;
var
  hProc : THANDLE;
  pIoc : PIoCounters;
begin
  hProc := OpenProcess(PROCESS_ALL_ACCESS,false,pid);

  if hProc <> 0 then
    begin

      pIoc := GetProcessIoCounters(hProc);

      if pIoc <> nil then
        begin
          lvProc.Items.Item[3].SubItems.strings[0] := inttostr(pIoc^.ReadOperationCount);
          lvProc.Items.Item[4].SubItems.strings[0] := inttostr(pIoc^.WriteOperationCount);
          lvProc.Items.Item[5].SubItems.strings[0] := inttostr(pIoc^.OtherOperationCount);
          lvProc.Items.Item[6].SubItems.strings[0] := inttostr(pIoc^.ReadTransferCount);
          lvProc.Items.Item[7].SubItems.strings[0] := inttostr(pIoc^.WriteTransferCount);
          lvProc.Items.Item[8].SubItems.strings[0] := inttostr(pIoc^.OtherTransferCount);
        end
      else
        begin
          lvProc.Items.Item[3].SubItems.strings[0] := 'Error!';
          lvProc.Items.Item[4].SubItems.strings[0] := 'Error!';
          lvProc.Items.Item[5].SubItems.strings[0] := 'Error!';
          lvProc.Items.Item[6].SubItems.strings[0] := 'Error!';
          lvProc.Items.Item[7].SubItems.strings[0] := 'Error!';
          lvProc.Items.Item[8].SubItems.strings[0] := 'Error!';
        end;

    end
end;

Wenn man das ganze jetzt debugt (Denglisch?!?), sieht man, daß Delphi beim "end;" der Funktion GetProcessIoCounters abschmiert - und zwar irgendwo "zwischen" dem Code, also im CPU-Fenster! Zugriffsverletzung beim lesen von $irgendwas (Hexzahl sieht für mich ungewöhnlich hoch aus).

Wer hat so etwas vielleicht schon einmal erlebt und kann mir helfen?


Dank im Voraus,


Sven

[choose]

Hallo Nachaz,

zunächst einmal herzlich willkommen bei der Delphi-PRAXiS!


Wenn ich Deinen Code richtig interpretiere, ist zunächst einmal die Aufrufkonvention Deiner Implementierung mit
Function(hProc : THandle; var IoCounters : PIoCounters) : BOOL; nicht ganz Stimmig: Hier sollte die Konvention stdcall verwendet werden und nicht die Delphi-Default Konvention (register).
Darüber hinaus ist die Signatur der Funktion nicht korrekt übersetzt: Bei einem CallByReference (var) wird bereits ein Pointer auf die Tatsächliche Struktur übergeben. Die beiden Signaturen
procedure ARoutine(var AnInt: Integer); und
procedure ARoutine(AnInt: PInteger); sind im Hinblick auf den erzeugten Code identisch. Mit Deiner Signatur
procedure ARoutine(var Something: PioCounters) übergibst Du folglich eine Referenz (einen Pointer) auf einen Pointer...
Typischerweise werden solche Funktionen bei der Übersetzung mit der CallByReference-Variante unter Beibehaltung der Hungerian-Notation in Delphi umgesetzt, also
procedure ARoutine(var lpIoCounters: TIoCounters) Wenn Du das umsetzt, ergibt sich der andere gravierende Fehler Deiner Implementierung (die Übergabe eines Pointers, der bisher nicht initialisiert wurde) von selbst...

Ich bin zwar kein Experte bei Header-Übersetzungen, aber ich habe einmal versucht, die Umsetzung gemäß der Unit Windows für die Funktion GetProcessIoCounters umzusetzen. Hierbei verwende ich jedoch, im Gegensatz zu Deinem Ansatz, keine dynamische Bindung:

Delphi-Quellcode:

type
  _IO_COUNTERS = record
    ReadOperationCount  : LONGLONG;
    WriteOperationCount : LONGLONG;
    OtherOperationCount : LONGLONG;
    ReadTransferCount   : LONGLONG;
    WriteTransferCount  : LONGLONG;
    OtherTransferCount  : LONGLONG;
  end;
  TIoCounters = _IO_COUNTERS;

function GetProcessIoCounters(hProcess: THandle;
  var lpIoCounters: TIoCounters): BOOL; stdcall external kernel32;

Aufgerufen werden kann die Funktion dann (ohne irgendwelche Pointer) in der Form

Delphi-Quellcode:

var
  myCounters: TIoCounters;
begin
  if GetProcessIoCounters(GetCurrentProcess, myCounters) then
    DoLog(myCounters)
  else
    DoLogError;

[Nachaz]

Danke! Werd' mal probieren, ob das so funktioniert. Habe stdcall tatsächlich vergessen. In dieser ganzen Pointerei bin ich noch nicht so firm, gelobe aber Besserung.


Gruß,


Sven