Как Подсчитать Время Работы Программы

Тема в разделе "Delphi - Компоненты", создана пользователем shilovec5377, 15 апр 2012.

  1. shilovec5377

    shilovec5377 Member

    Регистрация:
    13 апр 2012
    Сообщения:
    12
    Симпатии:
    0
    привет. помогите пжподсчитать время работы программы.
    спасибо.
     
  2. sinkopa

    sinkopa Well-Known Member

    Регистрация:
    17 июн 2009
    Сообщения:
    344
    Симпатии:
    9
    :D какой программы? своей? чужой?

    своей и просто подсчитать:
    Код (Delphi):
    program MyProg;

    uses
    Windows, Forms, SysUtils,
    Unit1 in 'Unit1.pas' {Form1};

    {$R *.res}

    var
    timestart,timestop: TTimeStamp;

    begin
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);

    timestart := DateTimeToTimeStamp(Now);
    Application.Run;
    timestop := DateTimeToTimeStamp(Now);

    MessageBox(0,PChar(Format('Программа работала %d миллисекунд',
    [Trunc(TimeStampToMSecs(timestop) - TimeStampToMSecs(timestart))])),
    PChar(Application.Title), MB_OK + MB_ICONINFORMATION + MB_TOPMOST);
    end.
    чужой запущенной (по ID или имени файла) или своей,
    с получением времени запуска и времени работы:
    Код (Delphi):
    uses
    Windows, SysUtils, TlHelp32;

    { Конвертирует FileTime в TDatetime формат}
    function FileTime2DateTime(FileTime: TFileTime): TDateTime;
    var
    LocalTime: TFileTime;
    DOSTime : Integer;
    begin
    FileTimeToLocalFileTime(FileTime, LocalTime);
    FileTimeToDosDateTime(LocalTime, LongRec(DOSTime).Hi, LongRec(DOSTime).Lo);
    Result := FileDateToDateTime(DOSTime);
    end;

    { Получает информацию о времени запуска и времени выполнения процесса }
    function GetProcessTimeInfo(const PID: Cardinal; out StartTime, RunTime: string): Boolean;
    var
    CreateFileTime : Windows.FILETIME;
    ExitFileTime  : Windows.FILETIME;
    KernelFileTime : Windows.FILETIME;
    UserFileTime  : Windows.FILETIME;
    ActualTime   : TDateTime;
    Dif         : TDateTime;
    CreationTime  : TDateTime;
    h : THandle;
    begin
    Result := False;
    StartTime := '';
    RunTime  := '';

    h := OpenProcess(PROCESS_QUERY_INFORMATION,false,PID);
    if (h <> 0) then
    begin
    ActualTime:=Now;
    if GetProcessTimes(h, CreateFileTime, ExitFileTime, KernelFileTime, UserFileTime) then
    begin
    CreationTime := FileTime2DateTime(CreateFileTime); // время запуска процесса (программы)
    StartTime := FormatDateTime('DD-MM-YYYY в HH:NN:SS',CreationTime);

    Dif := ActualTime - CreationTime;   // время прошедшее с момента запуска процесса (программы)
    RunTime := FormatDateTime('HH ч. NN мин. SS сек.',Dif); // FormatDateTime('HH:NN:SS',Dif);
    Result := True;
    end;
    CloseHandle(h);
    end;
    end;

    { Проверяет, запущена ли программа и Получает ID процесса }
    function ProcessRunning(const ExeName: String; out PID: Cardinal): Boolean;
    var
    SnapHandle : THandle;
    PE : TProcessEntry32;
    Continue : Boolean;
    begin
    Result := False;
    PID := 0;
    SnapHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    try
    Continue := Process32First(SnapHandle, PE);
    while Continue do
    begin
    if AnsiCompareText(PE.szExeFile, ExeName) = 0 then
    begin
    PID := PE.th32ProcessID;
    Result := True;
    Exit;
    end;
    Continue := Process32Next(SnapHandle, PE);
    end;
    finally
    CloseHandle(SnapHandle);
    end;
    end;
    пример использования:
    Код (Delphi):
    procedure TForm1.btn1Click(Sender: TObject);
    var
    PID: Cardinal;
    StartTime, RunTime: string;
    s: string;
    begin

    // PID := GetCurrentProcessId; // ID текущего процесса

    if not (ProcessRunning('notepad.exe',PID)) then // ID процесса по имени файла программы
    begin
    ShowMessage('программа НЕ запущена');
    Exit;
    end;


    if GetProcessTimeInfo(PID,StartTime, RunTime) then
    s := Format('Программа была запущена: %-20s'#13#10+'Время работы программы : %-16s',[StartTime, RunTime])
    else
    s := 'Не удалось получить информацию о программе.';

    ShowMessage(s);
    end;
     
Загрузка...

Поделиться этой страницей