Einzelnen Beitrag anzeigen

NicoDE
(Gast)

n/a Beiträge
 
#2

Re: Beschränkung von GetTickCount umgehen

  Alt 21. Jan 2004, 07:07
Um die tatsächliche 'System Up Time' zu ermitteln, muss Deine Variante von Anfang an auf dem Server (ohne Unterbrechung) laufen und mindestens alle 49,7 Tage aufgerufen werden.

Da schon in http://www.delphipraxis.com/topic746...ootet+ist.html die Frage gestellt wurde, hier die Funktionen, um die gesuchten Performance-Daten auf einem NT-basierten System auszulesen.

Es wird das Registry-Interface benutzt, da die Performance Data Helper (PDH) API nur auf NT-basierten Systemen zur Verfügung steht (und ein dynamisches Laden des Modules würde noch mehr Aufwand bedeuten).

Delphi-Quellcode:
////////////////////////////////////////////////////////////////////////////////
//
// 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;
Hinweise:
* GetSystemUpTimeNt() könnte zur Abfrage entfernter NT-Systeme erweitert werden (RegConnectRegistry)
* GetSystemUpTimeNt() ist langsamer - für 'Timer'-Schleifen ist GetTickCount() also immer noch sinnvoll
* GetSystemUpTimeNt() kann (für lokale Abfragen) durch Sichern der Counter-Indizes beschleunigt werden
(es wurde darauf verzichtet, da in einem Package globale Variablen stören würden)
* wer ohne SysUtils auskommen will, soll es selbst umschreiben

Legal Issues:
Public Domain

Foo:
Wer sein NT-System länger als 49,7 Tage laufen hat, möge die Funktion prüfen - hab gerade keines zur Hand.

[edit] Kommentare erweitert und zusätzliche Sicherheitsabfragen im Code, RegCloseKey vergessen [/edit]
  Mit Zitat antworten Zitat