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.