секундомер процессов

[evgedosha]

Добрый день прошу помощи, мне нужно сделать секундомер процессов, я смог сделать для одного процесса по выбору, а мне нужно что бы секундомер работал сразу для нескольких процессов (например из списка в мемо/листбокс) т.е свой секундомер для каждого процесса из списка(что бы в итоге получилось в таком виде в (мемо/листбоксе)
explorer.ехе - 0.00.00
iexplore.exe - 0.00.00
chrome.exe- 0.00.00
вот код который я сделал для одного процесса:

var
  Form1: TForm1;
  time: integer = 0;
   i, i1: real;
implementation

function processExists(exeFileName: string): Boolean;
var
    ContinueLoop: BOOL;
    FSnapshotHandle: THandle;
    FProcessEntry32: TProcessEntry32;

begin
    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
    ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
    Result := False;
    while Integer(ContinueLoop) <> 0 do
    begin
      if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
        UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
        UpperCase(ExeFileName))) then
      begin
        Result := True;
      end;
      ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
    end;
    CloseHandle(FSnapshotHandle);
end;



{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);

begin
i:=i+1;
i1:=i / (24*3600);
  Label1.Caption:=FormatDateTime('hh:nn:ss', i1);
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
    if processExists(edit1.text) then
   begin
     Timer1.Enabled:=true;
     end
           else
       Timer1.Enabled:=false;
end;

procedure TForm1.Button1Click(Sender: TObject);
var s:integer;
begin

if edit1.Text= EmptyStr then
showmessage ('vvedite process')
else
timer2.Enabled:=true;
end;

[GreenWizard]

Пряморукий способ - http://www.codeproject.com/Articles/...etProcessTimes
Криворукий способ - добавляем список процессов и, вместо поиска конкретного процесса, ищем его в списке нашем, добавляем при необходимости, и обновляем его таймер

точнее сказать не могу т.к. лень прогу писать... пиши вопросы, что не ясно

[evgedosha]

пример хороший как раз как мне нужно только мне достаточно одной колонки running time, но там я так понимаю Си, а я ни бум бум в нем, вообще только начинаю так сказать, осваиваю делфи, про криворукий способ что то не понял( или ты не так понял) мне нужно что бы в списке процессов у каждого считалось время, как в том примере, что ты кинул

[GreenWizard]

Много вариантов реализации есть)) я просто не знаю какой предпочтительнее, а все описывать - лень и долго
вот основной код (псевдокод):

function processExists(exeFileName: string): Boolean;
var
    ContinueLoop: BOOL;
    FSnapshotHandle: THandle;
    FProcessEntry32: TProcessEntry32;

begin
    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
    ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
    Result := False;
    while Integer(ContinueLoop) <> 0 do
    begin
      if not ПроверкаЕстьЛиПроцессВСписке(FProcessEntry32) then
      begin
        ДобавляемПроцесс;
        УстановитьТаймерРаботы(FProcessEntry32, 0);
      end
      else
         УвеличитьТаймерРаботы(FProcessEntry32);
      ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
    end;
    CloseHandle(FSnapshotHandle);
end;

Вот реализация этих 3 ф-ий сильно зависит от многих факторов (где храним список? как? и т.д.)

[evg_m]

Криворукий способ - добавляем список процессов и, вместо поиска конкретного процесса, ищем его в списке нашем, добавляем при необходимости, и обновляем его таймер

0. убираем все глобальные переменные (кроме Form1: TForm1

var
  Form1: TForm1;
//  time: integer = 0;
//   i, i1: real;

1. определяем информацию необходимую для одного процесса

type TcontrolProcess =record nameprocess: string; timer: TTime; end;

2. составляем список процессов

contorolProsess: array of TContolProcess;

3. реализуем добавление процесса в список.

Tform1 =class
....
public
  procedure AddProcess(const processname: string);
....
end;

procedure TForm1.AddProcess(const processname: string);
begin
  currentlength:=Length(controlProcess);
  SetLength(controlProcess, currentlength+1);
  controlProcess[currentlength].nameprocess:=processname;
  controlProcess[currentlength].timer1:=0;
end;

Теперь чтобы добавить надо где-то вызвать
AddProcess(<и указать какой процесс хотим добавить>);
Где и как вызвать AddProcess? к примеру добавить кнопку и при ее нажатии

procedure Tform1.buttonOnclick(sender: TObject);
begin
   AddProcess(self.Edit1.Text); //добавить процесс с именем введеным в Edit
end;

а можно сразу при старте заполнить

procedure Tform1.formCreate(sender: TObject);
begin
   AddProcess('exporer.exe');
  AddProcess('FireFox.exe');
end;

4. там где мы периодически опрашивали один процесс делаем опрос всех потоков из нашего списка.

procedure TForm1.Timer2Timer(Sender: TObject);
begin
   timer2.enabled:=false; //хороший тон если мы не уверены что успеем все проверить до след. "звонка" тоотключим "звонок" 
    
  try //чтобы быть уверенными что в конце звонок будет включен 
   for j:=0 to length(controlProcess)-1 do begin
    if processExists(controlProcess[j].nameprocess) then
     controlProcess[j].timer1:=controlProcess[j].timer1+1;
     // и можем тут же вывести если будем знать куда
     controlProcess[j].MyInfoLabel.Caption:=formatdatetime(controlProcess[j].timer1, 'hh:mm:ss');
   end;
   finally // чтобы не случилось звонок надо все равно включить
   timer2.enabled:=true; //мы все сделали и теперь можно включить звонок
   end;
end;

чтобы знать куда выводить изменяем
п.1.

type TcontrolProcess =record nameprocess: string; timer: TTime; mynfolabel: Tlabel; end;

п.3.

  controlProcess[currentlength].nameprocess:=processname;
  controlProcess[currentlength].timer1:=0;
  controlProcess[currentLength].MyInfoLabel:=LabelXXX';

[evgedosha]

Спасибо буду разбираться.