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

[Lomanu4]

Подсчет своей программы

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;