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

[shilovec5377]

привет. помогите пжподсчитать время работы программы.
спасибо.

 

[sinkopa]

привет. помогите пжподсчитать время работы программы.
спасибо.

какой программы? своей? чужой?

своей и просто подсчитать:

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 или имени файла) или своей,
с получением времени запуска и времени работы:

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;

пример использования:

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;