program TZ_CHECK { J R Stockton ; Written for Delphi 3 : DCC32 -cc } ;

{ I have only been able to test this myself in the UK.

  Scan windows.pas for TTimeZoneInformation,
  see Win32 Help via index for TIME_ZONE_INFORMATION.

  I suspect an error in my Win32 Help, since the transition times
  look as if in Local not GMT; and in the Win98 1st Edn data, as
  UK/EU changes are actually at 0100h GMT.
  }

uses Windows, SysUtils ;


const
T15018 = 15018 ;   // MJD of TDateTime base
T25569 = 25569.0 ; // TDateTime for UNIX base 1970-01-01
Days = ' days.' ;


procedure TryGTC ;
var TSB : cardinal ;
begin ;
  TSB := GetTickCount ;
  Writeln(' GetTickCount : Since Windows boot = ', TSB:20, ' ms,',
    TSB/864E5:7:3, Days) ;
  end {TryGTC} ;


procedure TryQPC ;
var PF, PC : { use int64 if available }
  record Case byte of 0: (L:TLargeInteger); 1: (C:comp) end ;
B : boolean ;
begin ;
  B := QueryPerformanceFrequency(PF.L) ;
  Write(' QueryPerformanceFrequency :') ;
  if B then Write(' ', PF.C:15:0, ' Hz') else write(B) ; Writeln ;
  if B then begin B := QueryPerformanceCounter(PC.L) ;
    Write('   QueryPerformanceCounter =') ;
    if B then Write(' ', PC.C:15:0,
      PC.C/PF.C:13:3, ' s, ', PC.C/PF.C/86400:7:3, Days) else write(B) ;
    Writeln ;
    end ;
  end {TryQPC} ;


procedure TryRDTSC ;

{ RDTSC instruction needs Pentium or better, returns count of CPU clock
  cycles ; only for certain processors.  ** See RDTSC.PAS ** }

function FrdtscL : longint ; assembler ;
asm  dw $310F {Clock to edx:eax}  end {FrdtscL} ;

procedure GetCycleCount(var Lo, Hi : integer) { tested in longcalc.pas } ;
asm  push ebx ; mov ecx,eax ; mov ebx,edx
  DB 0FH ; DB 031H
  mov dword ptr[ecx], eax ; mov dword ptr[ebx], edx
  pop ebx  end {Bob Lee} ;

type LH = record L, H : integer end {no Int64 in my D3} ;

var R : comp ; T0, T1 : longint ;

begin ;
  Write(' RDTSC : Approximate CPU speed = ') ;
  T0 := FrdtscL ; Sleep(1000) ; T1 := FrdtscL ; Dec(T1, T0) ;
  Writeln(T1:11, ' Hz') ;

  with LH(R) do GetCycleCount(L, H) ;

  Writeln('   CPU cycles', R:20:0,
    ',  so about ', R/T1:12:3, ' s, ', R/T1/86400:7:3, Days) ;

  end {TryRDTSC} ;


function ShowTime(const D : TSystemTime) : string ;
const DN : array [0..6] of string [3] =
  ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat') ;
begin with D do begin
  if WMonth=0 then begin Result := ' Unspecified' ; EXIT end ;
  if WYear=0 then Result := Format(' Month %2.2d, %s #%d',
    [wMonth, DN[wDayOfWeek], wDay])
    else Result := Format(' %4.4d-%2.2d-%2.2d, %s ',
    [wYear, wMonth, wDay, DN[wDayOfWeek]]) ;
  Result := Result + Format(' @ %2.2d:%2.2d:%2.2d.%3.3d',
    [wHour, wMinute, wSecond, wMilliseconds])
    end ;
  end {ShowTime} ;


procedure TrySysTim ;
var ST : TSystemTime ;
begin ;
  GetSystemTime(ST) ;
  Writeln(' GetSystemTime : ', ShowTime(ST), ' GMT') ;
  with ST do Writeln('   => UNIX seconds count = ',
    (((Trunc(EncodeDate(wYear, wMonth, wDay))-T25569)*24
      +wHour)*60+wMinute)*60+wSecond:1:0) ;
  end {TrySysTim} ;


function ItIs(const T : TDateTime) : string ;
var Yr, Mo, Dy, H, M, S, C : word ;
begin DecodeDate(T, Yr, Mo, Dy) ; DecodeTime(T, H, M, S, C) ;
  Result := Format(' %d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d ',
    [Yr, Mo, Dy, H, M, S]) end {ItIs} ;


function W2(const Bias : integer ; Season : string) : string ;
var Q : double ;
begin Q := 12.000001 - Bias/60 ;
  W2 := Format(' : %s %2.2d:%2.2d', [Season, Trunc(Q), Round(60*Frac(Q))]) ;
  end {W2} ;


procedure TryGTZI(const TDT : TDateTime) ;
var GTZI : cardinal ; TZI : TTimeZoneInformation ;
TD : TDateTime ; Card : cardinal ; WinterDiff, SummerDiff : integer ;
const TZID : array [0..2] of string [21] = ('',
  'TIME_ZONE_ID_STANDARD', 'TIME_ZONE_ID_DAYLIGHT') ;
begin ;

  GTZI := GetTimeZoneInformation(TZI) ;
  Write(' According to Windows :  GTZI = ', GTZI, '  =>  ') ;

  if GTZI=TIME_ZONE_ID_INVALID then begin
    Writeln('TIME_ZONE_ID_INVALID.') ; EXIT end ;

  with TZI do begin


    {$IFDEF TEST} BIAS:=-330 ; DAYLIGHTBIAS:=0; STANDARDBIAS:=0; {$ENDIF}


    Writeln(TZID[GTZI]) ;
    Writeln('   Bias = ', Bias,
      '  StandardBias = ', StandardBias,
      '  DaylightBias = ', DaylightBias, '   (minutes)') ;

    WinterDiff := Bias + StandardBias ;
    SummerDiff := Bias + DaylightBias ;

    Writeln('   At midday GMT, local time is',
      W2(WinterDiff, 'Winter'), W2(SummerDiff, 'Summer')) ;
    Writeln ;

    if SummerDiff <> WinterDiff then Writeln(
      Format('   %s', [DaylightName]),
        ' after', ShowTime(DaylightDate), ' civil'^M^J,
      Format('   %s', [StandardName]),
        ' after', ShowTime(StandardDate), ' civil'^M^J) ;

    case GTZI of
      0 : {TIME_ZONE_ID_UNKNOWN } TD := TDT + Bias/1440 { ? } ;
      1 : {TIME_ZONE_ID_STANDARD} TD := TDT + WinterDiff/1440 ;
      2 : {TIME_ZONE_ID_DAYLIGHT} TD := TDT + SummerDiff/1440 ;
      else begin Writeln('   *** GTZI = ', GTZI, ' ***') ; EXIT end ;
      end ;

    Writeln('   GMT =', ItIs(TD),
      '   True (GMT) MJD = ', Trunc(TD) + T15018,
      '   JD = ', (TD + T15018 + 2400000.5):1:3) ;

    Write('   UNIX time_t = ') ;
    Card := Round( ( TD - T25569 ) * 86400 ) ;
    Writeln(Card, ' sec, from 1970-01-01 00:00:00 GMT.') ;

    end { w TZI } ;
  end {TryGTZI} ;



procedure TryTDT(const DT : TDateTime) ;
begin ;
  Writeln(' Delphi : Now = ', DT:1:6,
    '   Date = ', Date:1:0, '   Time = ', Time:1:6) ;
  Writeln('   It is', ItIs(DT),
    '   Local MJD (CMJD) = ', (Trunc(DT) + T15018)) ;
  end {TryTDT} ;


var TN : TDateTime ;

BEGIN ;
Writeln('TZ_CHECK (c) www.merlyn.demon.co.uk >= 2003-09-12 See Win32 Help') ;
Writeln(' Test and demonstration of some Win32 Date/Time system routines.') ;
TN := Now ;

Writeln ; TryTDT(TN) ; Writeln ; TrySysTim ; Writeln ; TryGTZI(TN) ;
Writeln ; TryGTC ; Writeln ; TryQPC ; Writeln ; TryRDTSC ;
END.