Отслеживание процесса

[medved6216]

Здравствуйте, написал программу по отслеживанию процессов, возникла проблема - она сжирает очень много памяти, каждые секунду по 5 мегабайт
Помогите решить проблему...

Вот код:

function FindProcess(const ExeFile: string): string;
const
  TH32CS_SNAPPROCESS  = $00000002;
var
  SH: THandle;
  TP: TProcessEntry32;
  PID: DWORD;
  I: Integer;
  S: string;
begin
  Result := '';
  if ExeFile = '' then Exit;
  SH := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if Integer(SH) < 0 then Exit;
  TP.dwSize := SizeOf(TProcessEntry32);
  if not Process32First(SH, TP) then Exit;
  PID := 0;
  for I := 0 to 999 do
  begin
    S := UpperCase(TP.szExeFile);
    if SameText(ExeFile, S) then
    begin
      PID := TP.th32ProcessID;
      Break;
    end;
    if not Process32Next(SH, TP) then Break;
  end;
  if PID = 0 then Exit;
  Result := S;
end; 

procedure TForm1.Timer1Timer(Sender: TObject);
var
a: string;
m: string;
s: string;
d: string;
begin
a:=FindProcess('a.exe');
m:=FindProcess('m.exe');
s:=FindProcess('s.exe');
d:=FindProcess('d.exe');
if a <> '' then
begin
edit3.Font.Color:=clgreen;
edit3.Text:='1';
end
else
begin
edit3.Font.Color:=clred;
edit3.Text:='12';
end;

if m <> '' then
begin
edit4.Font.Color:=clgreen;
edit4.Text:='1';
end
else
begin
edit4.Font.Color:=clred;
edit4.Text:='12';
end;

if s <> '' then
begin
edit5.Font.Color:=clgreen;
edit5.Text:='1';
end
else
begin
edit5.Font.Color:=clred;
edit5.Text:='12';
end;
if d <> '' then
begin
  if edit3.text='1' then
    begin
      if edit4.text='1' then
        begin
          if edit5.text='1' then
            begin
              edit1.font.color:=clgreen;
              edit1.text:='87';
            end
            else
    begin
      edit1.Font.Color:=clred;
      edit1.Text:='54';
    end;
        end
        else
    begin
      edit1.Font.Color:=clred;
      edit1.Text:='24';
    end;
    end
  else
    begin
      edit1.Font.Color:=clred;
      edit1.Text:='13';
    end;
end
else
begin
edit1.Font.Color:=clred;
edit1.Text:='123';
end;
end;

[prizrak1390]

Получайте список процессов в список (например в Listbox) и потом по Listbox'у бегайте с поиском

 for i:=0 to listbox1.items.count-1 do 
if listbox1.items.string[i]='a.exe' then....

Я вот недавно сталкивался с этой проблемой. Если нужен будет код, я покажу...но идея вроде понятна.

[medved6216]

prizrak1390, если не сложно скинь код

[prizrak1390]

Без проблем...
Значит есть такая вот функа:

function processlist:Tstringlist;
var
han : THandle;
ProcStruct : PROCESSENTRY32; // from "tlhelp32" in uses clause
sID : string;
begin
processlist:=Tstringlist.Create;
// Get a snapshot of the system
han := CreateToolhelp32Snapshot( TH32CS_SNAPALL, 0 );
if han = 0 then
   exit;
// Loop thru the processes until we find it or hit the end
ProcStruct.dwSize := sizeof( PROCESSENTRY32 );
if Process32First( han, ProcStruct ) then
   begin
     repeat
       sID := ExtractFileName( ProcStruct.szExeFile );
processlist.Add(sid);


     until not Process32Next( han, ProcStruct );
   end;
// clean-up
CloseHandle( han );
end;

И допустим у нас есть на форме компонент Listbox (Или любой другой, аналогичный компонент-список)

К примеру хочешь ты получать список процессов с интервалом,для этого в Timer вписываешь вот такую конструкцию:

listbox1.Items.Text:=processlist.Text;

Затем в button пишем такую конструкцию:
...

var
 i:integer;
  begin
 for i:=0 to listobx1.items.count-1 do begin
 if listbox1.items.strings[i]='winamp.exe' then showmessage('Winamp, found!');
 end;

...