Speicherleck, laufende Prozesse abfragen

[Phantom1]

Hi,

hab hier ein seltsames Problem unter Win2000-SP4 (unter WinXP läuft es normal). Die folgenden functionen verursachen extremen Speicherverbrauch bei allen laufenen Prozessen, auch die Threadanzahl erhöht sich bei allen laufenden Prozessen.

Die Function selbst soll nur die aktuell laufenden Prozesse ermitteln (ausgenommen sind die Dienste und die explorer.exe) und in der ListBox anzeigen.

Für den Code brauch man nur eine ListBox und einen Timer (interval 1000).

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses TLHelp32;

type
  TProcessSnapshot = array of Record
    FileName: TFileName;
    ProcessID: Cardinal;
  end;

function GetProcessPath(ProcID: DWORD): string;
var
  me32: TModuleEntry32;
  h   : THandle;
  s   : string;
begin
  s := '';
  h := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcID);
  if h <> INVALID_HANDLE_VALUE then
  begin
    me32.dwSize := sizeof(TModuleEntry32);
    Module32First(h, me32);
    s := me32.szExePath;
    CloseHandle(h);
  end;
  result := s;
end;

function GetProcessSnapshot(var ProcessSnapshot: TProcessSnapshot): Boolean;
var
  hSnap: THandle;
  ProcEntry: TProcessEntry32;
  fn: TFileName;
begin
  Result:=False;
  hSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if hSnap<>INVALID_HANDLE_VALUE then begin
    ProcEntry.dwSize:=SizeOf(ProcessEntry32);
    SetLength(ProcessSnapshot, 0);
    if Process32First(hSnap, ProcEntry) then
      while Process32Next(hSnap, ProcEntry) do begin
        fn:=AnsiLowerCase(GetProcessPath(ProcEntry.th32ProcessID));
        if (fn<>'') and (pos('explorer.exe', fn)=0) then begin
          SetLength(ProcessSnapshot, Length(ProcessSnapshot)+1);
          ProcessSnapshot[High(ProcessSnapshot)].FileName:=fn;
          ProcessSnapshot[High(ProcessSnapshot)].ProcessID:=ProcEntry.th32ProcessID;
        end;
      end;
    Result:=Length(ProcessSnapshot)>0;
  end;
  CloseHandle(hSnap);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  ProcessSnapshot: TProcessSnapshot;
  i: Integer;
begin
  if GetProcessSnapshot(ProcessSnapshot) then begin
    ListBox1.Items.BeginUpdate;
    ListBox1.Clear;
    for i:=Low(ProcessSnapshot) to High(ProcessSnapshot) do
      ListBox1.Items.Add(ProcessSnapshot[i].FileName);
    ListBox1.Items.EndUpdate;
  end;
end;

end.

[oldmax]

Hi
Ich kann mich irren, aber es ist möglich, das die Bearbeitung länger dauert wie der Timer-Intervall. Vielleicht nicht immer, aber manchmal. Da der Timer vermutlich ein Software-Interrupt ist, ruft er sich innerhalb der Bearbeitung auch mehrfach auf. Um das auszuschließen würde ich ersteinmal beim Eintritt timer1.Enabled auf false setzen uund erst zum Schluß wieder auf true.
Im weiteren Verlauf habe ich nicht verstanden die Listbox1.BeginUpdate, da bei mir folgende Befehlssequenz ausreicht:

Delphi-Quellcode:

Listbox1.Items.Clear; // alle einträge löschen
For i:=0 to...
  Listbox1.Items.Add(MyString);
end;

Aber gut, da könnt schon eine andere Delphi-Ausgabe deinen Code fordern.
Zuletzt fällt mir noch ein, das Methoden wie Add auch aus mehreren Call's besteht, was dem Programmierer nicht immer sichtbar und bewußt ist. So sind auch die Handles nicht einfach nur lesende Zugriffe. Aber wie gesagt, ich würd erst mal für die Abarbeitung den Timer ausschalten und dann mal sehen...
Gruß oldmax

[edit=SirThornberry]Delphi-Tags gesetzt. Mfg, SirThornberry[/edit]

[hoika]

Hallo,

ich würde mal MemCheck oder FastMM (beides siehe google)
ausprobieren, um festzustellen, welcher Speicher nicht freigegeben wird.


Heiko

[teebee]

Habe das mal hier mit Windows 2000 SP4 ausprobiert und kann Deine Problembeschreibung nicht nachvollziehen. Weder am Speicherverbrauch noch an der Threadanzahl ändert sich laut Taskmanager etwas.
Was mir auf den ersten flüchtigen Blick aber auffällt, ist dass Du keine Ressourcenschutzblöcke verwendest:try...finally

Gruß, teebee

[Phantom1]

Vielen dank für eure Tipps, leider besteht das Problem weiterhin.

Hier nochmal der gesamte Code, mit eueren Tipps:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
[img]
implementation

{$R *.dfm}

uses TLHelp32;

function GetProcessPath(ProcID: DWORD): string;
var
  me32: TModuleEntry32;
  hSnap   : THandle;
begin
  Result := '';
  hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcID);
  if hSnap <> INVALID_HANDLE_VALUE then
    try
      me32.dwSize := sizeof(me32);
      Module32First(hSnap, me32);
      Result := me32.szExePath;
    finally
      CloseHandle(hSnap);
    end;
end;

procedure GetProcessSnapshot(sl: TStringList);
var
  hSnap: THandle;
  ProcEntry: TProcessEntry32;
  fn: TFileName;
begin
  hSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if hSnap<>INVALID_HANDLE_VALUE then
    try
      ProcEntry.dwSize:=SizeOf(ProcEntry);
      if Process32First(hSnap, ProcEntry) then
        while Process32Next(hSnap, ProcEntry) do begin
          fn:=AnsiLowerCase(GetProcessPath(ProcEntry.th32ProcessID));
          if (fn<>'') and (pos('explorer.exe', fn)=0) then
            sl.Add(fn);
        end;
    finally
      CloseHandle(hSnap);
    end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled:=False;

  ListBox1.Clear;
  GetProcessSnapshot(TStringList(ListBox1.Items));

  Timer1.Enabled:=True;
end;

end.

Inzwischen konnte ich das Problem etwas eingrenzen: Wenn ich nämlich die function GetProcessPath weglasse, dann läuft alles normal. Es muss also irgendwie an dieser function liegen.

So sieht es normalerweise im Taskmanager aus:
http://www.dreamer.homeip.net/easyto...n_normal_1.jpg

wenn ich jetzt jedoch den Code bzw das Programm starte, sieht es nach wenigen Minuten so hier aus:
http://www.dreamer.homeip.net/easytoolz/Taskman_4.jpg

mfg

[brechi]

Hallo Phantom1,
ich geh mal davon aus, dass du es nicht in einer VM getestet hast.

Bist du dir sicher, dass du keinen Virus drauf hast, bzw ein Programm was einen globalen hook macht? Ich weiß nicht genau wie Module32First funktioniert, aber es werden die dlls direkt aus dem Zielprozess ausgelesen (vielleicht mit IPC). Und eine dll die in dem Zielprozess eben diese Funktion gehookt hat (und einen Programmierfehler hat) könnte dann dafür verantworltich sein.

Ich selber habe Win2k mit SP4 und kann es auch nicht nachvollziehen. Vielleicht solltest du mal Formatieren, oder mal schaun ob eine dll in jedem Prozess geladen ist die nicht dahingehört.

[Olli]

1. Woher die Annahme es sei ein Speicherleck? Ich ahne, daß da die Working Set Größe wiedermal falsch interpretiert wird. Denn selbst unter der Annahme, daß der Speicher in einem fremden Prozess alloziert wird, würde er sicher wieder freigegeben, oder? Insbesondere diverse Anti-Xware-Programme setzen auf ständiges Pollen der Prozesse und so weiter. Wäre ja fatal - und äußerst unwahrscheinlich, daß es erst nach 5 Jahren XP oder 7 Jahren 2K entdeckt wird - wenn es da ein Speicherleck gäbe.
2. Thema neue Threads, Speicher in anderen Prozessen. Dreimal dürft ihr raten wie
   
   Code:

   CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcID);

   funktioniert. Für das Auslesen der Prozesse allein sollte das Verhalten so nicht beobachtbar sein, sondern nur wenn Module ausgelesen werden. Na, keiner eine Idee?

Von brechi hätte ich ja eigentlich erwartet, daß der das weiß ...