utils/uutlTiming.pas

unit uutlTiming;

{ Package:      Utils
  Prefix:       utl - UTiLs
  Beschreibung: diese Unit enthält platformunabhängige Methoden für Zeitberechnungen und -messungen
                Mehr oder weniger platformunabhängige Timestampgenerierung.
                    GetTickCount64           ms-Timer
                    GetMicroTime             us-Timer analog php microtime()
  Achtung:      windows.pp deklariert auch eine GetTickCount64, wird gegen diese gelinkt
                läuft die exe nicht mehr unter XP. Unbeding uutlTiming *nach* windows einbinden. }


{$mode objfpc}{$H+}

interface

uses
  Classes
  {$ifdef Windows}
  , Windows
  {$else}
  , Unix, BaseUnix
  {$endif};

function GetTickCount64: QWord;
function GetMicroTime: QWord;

function utlRateLimited(const Reference: QWord; const Interval: QWord): boolean;

implementation

{$IF defined(WINDOWS)}
var
  PERF_FREQ: Int64;

function GetTickCount64: QWord;
begin
  // GetTickCount64 is better, but we need to check the Windows version to use it
  Result := Windows.GetTickCount();
end;

function GetMicroTime: QWord;
var
  pc: Int64;
begin
  pc := 0;
  QueryPerformanceCounter(pc);
  Result:= (pc * 1000*1000) div PERF_FREQ;
end;
{$ELSEIF defined(UNIX)}
function GetTickCount64: QWord;
var
  tp: TTimeVal;
begin
  fpgettimeofday(@tp, nil);
  Result := (Int64(tp.tv_sec) * 1000) + (tp.tv_usec div 1000);
end;

function GetMicroTime: QWord;
var
  tp: TTimeVal;
begin
  fpgettimeofday(@tp, nil);
  Result := (Int64(tp.tv_sec) * 1000*1000) + tp.tv_usec;
end;
{$ELSE}
function GetTickCount64: QWord;
begin
  Result := Trunc(Now * 24 * 60 * 60 * 1000);
end;

function GetMicroTime: QWord;
begin
  Result := Trunc(Now * 24 * 60 * 60 * 1000*1000);
end;

{$ENDIF}

function utlRateLimited(const Reference: QWord; const Interval: QWord): boolean;
begin
  Result:= GetMicroTime - Reference > Interval;
end;

initialization
{$IF defined(WINDOWS)}
  PERF_FREQ := 0;
  QueryPerformanceFrequency(PERF_FREQ);
{$ENDIF}
end.