Beschränkung von GetTickCount umgehen

[Dax]

Ich hab' das ganze nochmal ein wenig optimiert, muss nicht alle High(DWORD) Millisekunden mehr ausgeführt werden, sondern kann beliebig aufgerufen werden:

Delphi-Quellcode:

var
  QPF: Int64 = 0;

function GetTickCountEx: TUpTime;
begin
  if QPF = 0 then
    QueryPerformanceFrequency(QPF);
  QueryPerformanceCounter(Ticks);
  Ticks := Ticks div QPF;

  with Result do
  begin
    MilliSeconds := Ticks mod 1000;
    Seconds := (Ticks div 1000) mod 60;
    Minutes := (Ticks div 60000) mod 60;
    Hours := (Ticks div 3600000) mod 24;
    Days := ((Ticks div 3600000) div 24) mod 30;
    Months := ((Ticks div 3600000) div 24) div 30;
    Years := ((Ticks div 3600000) div 24) div 365;
  end;
end;

[edit=Chakotay1308]Beitrag befindet sich nun hier in der Code-Library. Mfg, Chakotay1308[/edit]

[Luckie]

Falls TUpTime ein eigener Datentyp ist, wäre dessen Deklaration interessant.

[Dax]

Der Beitrag war eingentlich als Ergänzung zu einem urspünglichen EIntrag in der Codelib gedacht, ich dachte, der wäre schon lange verschoben worden...
Na ja, ein Link kann ja nicht schaden..

[NicoDE]

Zitat von Dax:

Delphi-Quellcode:

if QPF = 0 then
  QueryPerformanceFrequency(QPF);
QueryPerformanceCounter(Ticks);
Ticks := Ticks div QPF;

Zitat von MSDN:

If the function fails, the return value is zero.

[Dax]

So besser?

Delphi-Quellcode:

var
  QPF: Int64 = 0;

function GetTickCountEx: TUpTime;
begin
  if QPF = 0 then
    QueryPerformanceFrequency(QPF);
  QueryPerformanceCounter(Ticks);
  if (QPF = 0) or (Ticks = 0) then
  begin
    Result.Milliseconds := Word(-1);
    Exit;
  end;
  Ticks := Ticks div QPF;

  with Result do
  begin
    MilliSeconds := Ticks mod 1000;
    Seconds := (Ticks div 1000) mod 60;
    Minutes := (Ticks div 60000) mod 60;
    Hours := (Ticks div 3600000) mod 24;
    Days := ((Ticks div 3600000) div 24) mod 30;
    Months := ((Ticks div 3600000) div 24) div 30;
    Years := ((Ticks div 3600000) div 24) div 365;
  end;
end;

[NicoDE]

Zitat von Dax:

So besser?

QueryPerformanceFrequency ist eine Funktion.
Warum verläßt Du dich darauf, dass die Funktion den Parameter in einem bestimmten (nicht dokumentierten) Zustand hinterläßt, anstatt den Rückgabewert zu verwenden?

[Luckie]

Hatte ich hie rnicht gestern einen Link gepostet? Wie dem auch sei, kuck dir das mal an: http://www.luckie-online.de/Delphi/S...ckCountEx.html

[Dax]

Wenn ich mich nicht irre, war der Link sinnlos: Das selbe steht schon in der Codelib, auch von NicoDE. Ich hab' nur meinen Algorithmus verbessert und wollte, das es eingetragen wird...

[himitsu]

> CodeLib > Beschränkung von GetTickCount umgehen


Erstmal was zu Dax letztem CL-Code:
Ticks ist wärend der Zuweisung an Result in Sekundenintervallen und nicht in Millisekunden ... das Ergebnis stimmt also nicht



So und nun was Neues/Erfreuliches:
In Vista hat Microsoft sich endlich dieses Problems gewidmet und GetTickCount64 eingeführt.

Delphi-Quellcode:

Function GetTickCount64: UInt64; StdCall;
  External 'Kernel32.dll' Name 'GetTickCount64';

Und das Ganze noch als nette Unit, welche auch schon früher läuft:

Delphi-Quellcode:

Unit GTCUnit;

// (c) 1997-2007 by FNS Enterprize's (FNSE.de)
//     2003-2007 by himitsu @ Delphi-PRAXiS.de
 
Interface
  Uses Windows;

  Var GetTickCount64: Function(): UInt64; StdCall;

Implementation
  Function _GetTickCount64: UInt64; StdCall;
    Var Freq, Ticks: UInt64;

    Begin
      If QueryPerformanceFrequency(Int64(Freq))
        and QueryPerformanceCounter(Int64(Ticks))
        and (Int64(Freq) > 0) Then Begin

        If Ticks >= UInt64(-1) div 1000 Then Result := Ticks div (Freq div 1000)
        Else Result := (Ticks * 1000) div Freq;
      End Else Result := 0;
    End;

Initialization
  GetTickCount64 := GetProcAddress(GetModuleHandle('Kernel32.dll'), 'GetTickCount64');
  If @GetTickCount64 = nil Then GetTickCount64 := @_GetTickCount64;

End.

Einfach Unit einbinden und GetTickCount64 wie eine normale Funktion aufrufen

Delphi-Quellcode:

Uses Windows, Unit1;

Var C, C2: UInt64;

Begin
  C  := GetTickCount64;
  Sleep(3000);
  C2 := GetTickCount64;
  Label1.Caption := IntToStr(C2 - C);
End;