Warning: date time problem

16 bit applications under windows NT might suffer from this problem, that
the date rolls over a few seconds before or after the time!!!

This makes it seem for a few seconds around midnight as if the date is
jumping about!

This message includes a very short unit "Datetime" to fix it.

This unit "Datetime" requires call32NT.  Datetime has no functions or
variables that you can access.  Just "include" it into your project.  It
modifies your application at run time to patch out the Delphi date and time
routines and replace them with its own.

The routine HackJmp is worth looking at.  (I once used a similar technique
with self-dissassembly to modify in-place the delphi exception handler to
produce a stack trace at the point at which an exception occurs.)

At runtime it patches in-place sysutils to update the Now, Date and Time
routines to thunk to the 32 bit system if possible.

unit Datetime;
{(C) Copyright 1998 Campbell Scientific Ltd}
{Free to use in your own projects providing this message remains intact}

{$F+}
interface

uses sysutils, winprocs, wintypes, call32nt, classes;

implementation

type
  { This is the record to store results from GetLocalTime }
  TSystemTime32=record
    Year : word;
    Month : word;
    DayOfWeek : word;
    Day : word;
    Hour : word;
    Minute : word;
    Second : word;
    Milliseconds : word;
  end;

{ Used for 32 bit procedural declaration }
Type TGetLocalTime32=Procedure(var SystemTime : TSystemTime32; id :
longint);

const
  GetLocalTime32 : TGetLocalTime32=nil;
  GetLocalTime32ID : longint=0;

{(C) 1998 Campbell Scientific Ltd; author Sam Liddicott }
{ Modify a routine in-place to jump to an alternate routine }
Procedure HackJmp(OldRoutine, NewRoutine : Pointer);
var
  Code, Data : word;
  OldAsData : Pointer;
  OldJmp : ^Byte absolute OldAsData;
  OldJmpAddress : ^Pointer absolute OldAsData;
begin
  { Get and fix code segment }
  Code:=Seg(Oldroutine^);
  { get a writable selector to the same place }
  Data:=AllocCSToDSAlias(Code);
  OldAsData:=Ptr(Data,Ofs(OldRoutine^));
  { Now can write JMP instruction to this }
  OldJmp^:=$EA; {JMP}
  Inc(OldJmp);
  OldJmpAddress^:=NewRoutine;
  FreeSelector(Data);
end;

{ Replacement function }
Function Now : TDateTime;
var
  SystemTime : TSystemTime32;
begin
  If Assigned(GetLocalTime32) then begin { 32bit if we can }
    GetLocalTime32(SystemTime,GetLocalTime32ID);
    { Now construct date and time }
    With SystemTime do

Result:=EncodeDate(Year,Month,Day)+EncodeTime(Hour,Minute,Second,Millisecond
s);
  end else { else the old way }
    Result:=Date+Time;
end;

Function Date : TDateTime;
var
  Year: Word;
  Month, Day: Byte;
  SystemTime : TSystemTime32;
begin
  If Assigned(GetLocalTime32) then begin { 32 bit if we can }
    GetLocalTime32(SystemTime,GetLocalTime32ID);
    { Now construct date and time }
    With SystemTime do
      Result:=EncodeDate(Year,Month,Day);
  end else begin { blagged from sysutils.pas }
    asm
        MOV     AH,2AH
        INT     21H
        MOV     Year,CX
        MOV     Month,DH
        MOV     Day,DL
    end;
    Result := EncodeDate(Year, Month, Day);
  end;
end;

Function Time : TDateTime;
var
  Hour, Min, Sec, HSec: Byte;
  SystemTime : TSystemTime32;
begin
  If Assigned(GetLocalTime32) then begin { 32 bit if we can }
    GetLocalTime32(SystemTime,GetLocalTime32ID);
    { Now construct date and time }
    With SystemTime do
      Result:=EncodeTime(Hour,Minute,Second,Milliseconds);
  end else begin { blagged from sysutils.pas }
    asm
        MOV     AH,2CH
        INT     21H
        MOV     Hour,CH
        MOV     Min,CL
        MOV     Sec,DH
        MOV     HSec,DL
    end;
    Result := EncodeTime(Hour, Min, Sec, HSec * 10);
  end;
end;

initialization
  { Declare 32bit function }
  GetLocalTime32ID:=Declare32('GetLocalTime','kernel32','p');
  If not Call32NTError then
    @GetLocalTime32:=@Call32;
  { Now hack out the delphi calls! And replace with our own! }
  HackJmp(@Sysutils.Now,@Now);
  HackJmp(@Sysutils.Date,@Date);
  HackJmp(@Sysutils.Time,@Time);
end.