////////////////////////////////////////////////////////////////////////////////
//
// GetSystemUpTimeNt()
//
// Uses the registry interface to get the value of the performance counter
// '\\localhost\System\System Up Time' in milliseconds (returns 0 on error).
//
function GetSystemUpTimeNt(): Int64;
{$IFDEF WIN32}
type
PPerfDataBlock = ^TPerfDataBlock;
TPerfDataBlock =
packed record
Signature :
array [0..3]
of WCHAR;
LittleEndian : DWORD;
Version : DWORD;
Revision : DWORD;
TotalByteLength : DWORD;
HeaderLength : DWORD;
NumObjectTypes : DWORD;
DefaultObject : DWORD;
SystemTime : SYSTEMTIME;
PerfTime : LARGE_INTEGER;
PerfFreq : LARGE_INTEGER;
PerfTime100nSec : LARGE_INTEGER;
SystemNameLength: DWORD;
SystemNameOffset: DWORD;
end;
PPerfObjectType = ^TPerfObjectType;
TPerfObjectType =
packed record
TotalByteLength : DWORD;
DefinitionLength : DWORD;
HeaderLength : DWORD;
ObjectNameTitleIndex: DWORD;
ObjectNameTitle : LPWSTR;
ObjectHelpTitleIndex: DWORD;
ObjectHelpTitle : LPWSTR;
DetailLevel : DWORD;
NumCounters : DWORD;
DefaultCounter : DWORD;
NumInstances : DWORD;
CodePage : DWORD;
PerfTime : LARGE_INTEGER;
PerfFreq : LARGE_INTEGER;
end;
PPerfCounterDefinition = ^TPerfCounterDefinition;
TPerfCounterDefinition =
packed record
ByteLength : DWORD;
CounterNameTitleIndex: DWORD;
CounterNameTitle : LPWSTR;
CounterHelpTitleIndex: DWORD;
CounterHelpTitle : LPWSTR;
DefaultScale : DWORD;
DetailLevel : DWORD;
CounterType : DWORD;
CounterSize : DWORD;
CounterOffset : DWORD;
end;
PPerfInstanceDefinition = ^TPerfInstanceDefinition;
TPerfInstanceDefinition =
packed record
ByteLength : DWORD;
ParentObjectTitleIndex: DWORD;
ParentObjectInstance : DWORD;
UniqueID : DWORD;
NameOffset : DWORD;
NameLength : DWORD;
end;
PLARGE_INTEGER = ^LARGE_INTEGER;
const
PERF_SIZE_LARGE = $00000100;
PERF_TYPE_COUNTER = $00000400;
PERF_COUNTER_ELAPSED = $00040000;
PERF_OBJECT_TIMER = $00200000;
PERF_DISPLAY_SECONDS = $30000000;
PERF_ELAPSED_TIME = PERF_SIZE_LARGE
or PERF_TYPE_COUNTER
or
PERF_COUNTER_ELAPSED
or PERF_OBJECT_TIMER
or
PERF_DISPLAY_SECONDS;
PERF_NO_INSTANCES = DWORD(-1);
var
ValSize: DWORD;
Counter: PChar;
CurrIdx: PChar;
CurrStr: PChar;
CntrStr: PChar;
CntrSys: DWORD;
CntrSUT: DWORD;
QrySize: DWORD;
QryData: PPerfDataBlock;
CurrObj: PPerfObjectType;
ObjLoop: DWORD;
CurrDef: PPerfCounterDefinition;
DefLoop: DWORD;
ObjInst: PPerfInstanceDefinition;
CntrVal: PLARGE_INTEGER;
{$ENDIF}
begin
Result := 0;
// indicates failure
{$IFDEF WIN32}
ValSize := 0;
if (RegQueryValueEx(HKEY_PERFORMANCE_DATA, '
Counter 009',
nil,
nil,
nil,
@ValSize) = ERROR_SUCCESS)
then
try
Inc(ValSize, 1024);
Counter := GetMemory(ValSize);
if (Counter <>
nil)
then
try
if (RegQueryValueEx(HKEY_PERFORMANCE_DATA, '
Counter 009',
nil,
nil,
PByte(Counter), @ValSize) = ERROR_SUCCESS)
then
begin
CntrStr :=
nil;
CntrSys := 0;
CntrSUT := 0;
CurrIdx := Counter;
while (CurrIdx[0] <> #0)
do
begin
CurrStr := PChar(@CurrIdx[StrLen(CurrIdx) + 1]);
if ((CntrSys = 0)
and (StrComp(CurrStr, '
System') = 0))
then
begin
CntrStr := CurrIdx;
CntrSys := StrToInt(
string(CurrIdx));
if (CntrSUT <> 0)
then
Break;
end;
if ((CntrSUT = 0)
and (StrComp(CurrStr, '
System Up Time') = 0))
then
begin
CntrSUT := StrToInt(
string(CurrIdx));
if (CntrSys <> 0)
then
Break;
end;
CurrIdx := PChar(@CurrStr[StrLen(CurrStr) + 1]);
end;
if ((CntrStr <>
nil)
and (CntrSys <> 0)
and (CntrSUT <> 0))
then
begin
QrySize := 0;
QryData :=
nil;
try
repeat
Inc(QrySize, 4096);
QryData := ReallocMemory(QryData, QrySize);
if (QryData =
nil)
then
Break;
ValSize := QrySize;
until (RegQueryValueEx(HKEY_PERFORMANCE_DATA, CntrStr,
nil,
nil,
PByte(QryData), @ValSize) <> ERROR_MORE_DATA);
if ((ValSize > 0)
and (QryData <>
nil))
then
if (QryData.Signature = '
PERF')
then
begin
CurrObj := PPerfObjectType(Cardinal(QryData) +
QryData.HeaderLength);
for ObjLoop := 1
to QryData.NumObjectTypes
do
begin
if ((CurrObj.ObjectNameTitleIndex = CntrSys)
and
(CurrObj.NumInstances > 0)
and
(CurrObj.PerfFreq.QuadPart >= 1000))
then
begin
CurrDef := PPerfCounterDefinition(Cardinal(CurrObj) +
CurrObj.HeaderLength);
for DefLoop := 1
to CurrObj.NumCounters
do
begin
if (CurrDef.CounterNameTitleIndex = CntrSUT)
and
(CurrDef.CounterType = PERF_ELAPSED_TIME)
then
begin
if (CurrObj.NumInstances = PERF_NO_INSTANCES)
then
CntrVal := PLARGE_INTEGER(Cardinal(CurrObj) +
CurrObj.DefinitionLength + CurrDef.CounterOffset)
else
begin
// first instance
ObjInst := PPerfInstanceDefinition(Cardinal(CurrObj) +
CurrObj.DefinitionLength);
CntrVal := PLARGE_INTEGER(Cardinal(ObjInst) +
ObjInst.ByteLength + CurrDef.CounterOffset);
end;
Result :=
(CurrObj.PerfTime.QuadPart - CntrVal.QuadPart)
div
(CurrObj.PerfFreq.QuadPart
div 1000);
// milliseconds
Break;
end;
CurrDef := PPerfCounterDefinition(Cardinal(CurrDef) +
CurrDef.ByteLength);
end;
Break;
end;
CurrObj := PPerfObjectType(Cardinal(CurrObj) +
CurrObj.TotalByteLength);
end;
end;
finally
if (QryData <>
nil)
then
FreeMemory(QryData);
end;
end;
end;
finally
FreeMemory(Counter);
end;
finally
RegCloseKey(HKEY_PERFORMANCE_DATA);
end;
{$ENDIF}
end;
////////////////////////////////////////////////////////////////////////////////
//
// GetSystemUpTime9x()
//
// Uses GetTickCount() to get the 'System Up Time' in milliseconds.
// Will wrap around to zero if the system is run continuously for 49.7 days!
//
function GetSystemUpTime9x(): Int64;
begin
{$IFDEF WIN32}
Result := GetTickCount();
{$ELSE}
Result := 0;
{$ENDIF}
end;
////////////////////////////////////////////////////////////////////////////////
//
// GetSystemUpTime()
//
// Wrapper for GetSystemUpTimeNt() and GetSystemUpTime9x()
//
function GetSystemUpTime(): Int64;
begin
Result := GetSystemUpTimeNt();
if (Result = 0)
then
Result := GetSystemUpTime9x();
end;
////////////////////////////////////////////////////////////////////////////////
// Sample
procedure TForm1.Button1Click(Sender: TObject);
var
UpTimeNt: Int64;
UpTime9x: Int64;
begin
UpTime9x := GetSystemUpTime9x();
UpTimeNt := GetSystemUpTimeNt();
ShowMessage(Format('
GetTickCount: %d day(s) %2.2d:%2.2d:%2.2d.%3.3d'#10 +
'
Perf-Counter: %d day(s) %2.2d:%2.2d:%2.2d.%3.3d', [UpTime9x
div 86400000,
UpTime9x
mod 86400000
div 3600000, UpTime9x
mod 3600000
div 60000,
UpTime9x
mod 60000
div 1000, UpTime9x
mod 1000, UpTimeNt
div 86400000,
UpTimeNt
mod 86400000
div 3600000, UpTimeNt
mod 3600000
div 60000,
UpTimeNt
mod 60000
div 1000, UpTimeNt
mod 1000]));
end;