{uDate - defines some new DateTypes and provides routines for it
Copyright (c) 1998-2000 by Bernhard R. Link (2:2476/841.64;brl@gmx.de)
marked parts out of MKWCRT - Copyright 1993 by Mark May - MK Software
****************************************************************************
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
****************************************************************************}

(* $Id: udate.pas,v 1.24 2003/03/14 23:09:58 olly98 Exp $ *)

Unit UDate;
{$I platform.inc}
{$I mkglobal.inc}
Interface
Uses
{$IFDEF PPC_VIRTUAL}
  use32,Dos,
  {$DEFINE PureDos} {VirtualPascal seems to be better in emulating Dos than in direct support}
 {$ELSE}
  {$IFDEF PPC_DELPHI}
    SysUtils,
   {$ELSE}
    {$IFDEF WINDOWS}
      WinDos,
     {$ELSE}
      {$IFDEF OS_LINUX}
        Linux,
       {$ELSE}
        {$IFDEF OS_DOS}
          Dos,
          {$Define PureDos}
         {$ELSE}
          {$STOP Unknown OS!}
        {$ENDIF}
      {$ENDIF}
    {$ENDIF}
  {$ENDIF}
{$ENDIF}
aString,atypes;

{$IFDEF PPC_Delphi}
  {$IFNDEF PPC_Delphi2}
    {$Define UseDummy} {Irgendwo ist da noch was durcheinander}
  {$ENDIF}
 {$ELSE}
  {$IFDEF PPC_Virtual}
    {$Define UseDummy}
   {$ELSE}
    {$IFNDEF OS_Linux}
     {$Define Usedummy}
    {$ENDIF}
  {$ENDIF}
{$ENDIF}

Type
  TDosDate=uInt4; {normal dos-packed date (?)}
  {Do not forget the to include the wrapper if calculating}
  {this type includes whole date and time-info}

  TuDateTime = record
      Year,Month,Day,Hour,Min,Sec: Word;{Longint gegen berlauf}
      end;


(*
 *  used by GetMonthStr
 *)
  Const Months:array[1..12] of String[3]
              = ('Jan','Feb','Mar','Apr','May','Jun',
                 'Jul','Aug','Sep','Oct','Nov','Dec');


  const
        C1970 = 2440588;

function CalcDosPacked(const T: TuDateTime):tDosDate;
procedure UnpackDosDate(Date:TDosDate;var D:TuDateTime);

{returns today's date and current time}
Function GetDosDate:TDosDate;

Function GetTimeStamp:uInt4;
{Wiederholt sich erst nach 3 Jahren}

{returns difference in days between Date1 and Date2}
Function DateDiff(Date1, Date2: TDosDate): Integer;

Type
{$IFDEF LongStrings}
     TDateTimeStr=AnsiString;
     TPKTDateTimeStr=AnsiString;
{$ELSE}
   {$IFDEF PPC_FPC}
     TDateTimeStr=String[21];
     TPKTDateTimeStr=String[19];
   {$ELSE}
     TDateTimeStr=String[Length('dd.mon yyyy  hh:mm:ss')];
     TPKTDateTimeStr=String[Length('dd mon yy  hh:mm:ss')];
   {$ENDIF}
{$ENDIF}

(*
  TDateTimeStr: dd.mon yyyy  hh:mm:ss

    Type  Starts at Length
    Day   1         2
    Month 4         3
    Year  8         4
    Time  14        8
*)

(* function ConvertToDateTimeStr(dosDate: TDosDate): TDateTimeStr;
equals *)
Function DateTimeStr(DosDate:TDosDate):TDateTimeStr;


Function CutForPKT(const DT:TDateTimeStr):TPKTDateTimeStr;
Function PktDateTimeStrToDateTimeStr(const s: TPktDateTimeStr): TDateTimeStr;
Function PackDateTime(const dt:TDateTimeStr):TDosDate;

(*
  Desc:
    Converts
      DD-MM-YY to full TDateTimeStr, appends given time
  Parameters:
    MMDDYY - String to convert
    Time   - Time in Format hh:mm:ss
*)
Function Convert_MMDDYYTime_To_DateTimeStr(const MMDDYY, Time: String): TDateTimeStr;


(*
  converts d.m.y to DosDate
*)
Function Convert_DMY_To_TDosDate(const DMY: string): TDosDate;

Function Convert_DateTimeStr_To_MMDDYY(const DTStr: tDateTimeStr): string;

(*
  Desc:
    Converts given Date and TimeStamp in DOS-Format to a TDateTimeStr
*)
function Convert_DosDateTime_To_DateTimeStr(const DateInfo, TimeInfo: TDosDate): TDateTimeStr;


(*
  Notes:
    Result is not a full TDateTimeStr, it contains only the time!!
*)
Function ConvertToTimeStr(dosDate:TDosDate):TDateTimeStr;

(*
  Notes:
    Result is not a full TDateTimeStr, it contains only the date!!
*)
Function ConvertToDateStr(dosDate:TDosDate):TDateTimeStr;

(** string-routines **)

Function GetDOWStr(Dow: Word): ShortString;

Function GetDOW3Str(Dow: Word): ShortString; (* result is only 3 chars long *)

(*
 *  Desc:
 *  Converts given month to a string[3]
 *)
Function GetMonthStr(MonthNo: Word): ShortString;

(*
  Desc:
    Converts string[3] to month
  Returns:
    JANuary = 1
    ...
    DECember = 12
    else
    1
*)
function MonthStrToInt(str: string): Integer;

Function FormattedDosDate(Const DosD: TDosDate; Mask: OpenString): TString;

(* Unix-Date-Routines *)

Function DosDateToUnixDate(FDate: TDosDate): LongInt;
Function TDateTimeStrToUnixDate(const FDate: TDateTimeStr): LongInt;

Function UnixDateToDosDate(const unx : LongInt): TDosDate;


(*****************************************************************************)

Implementation

uses
  uString{$IFDEF UseErrDlg},ErrDlg{$ENDIF};

 const
   D0    =    1461;
   D1    =  146097;
   D2    = 1721119;

Function GregorianToJulian(DT: TuDateTime): LongInt;

Var
  Century: LongInt;
  XYear: LongInt;
  Month: LongInt;

  Begin
  Month := DT.Month;
  If Month <= 2 Then
    Begin
    Dec(DT.Year);
    Inc(Month,12);
    End;
  Dec(Month,3);
  Century := DT.Year Div 100;
  XYear := DT.Year Mod 100;
  Century := (Century * D1) shr 2;
  XYear := (XYear * D0) shr 2;
  GregorianToJulian :=  ((((Month * 153) + 2) div 5) + DT.Day) + D2
    + XYear + Century;
  End;

Function JulianToGregorian(     JulianDN : LongInt) : TuDateTime;
  Var
    Temp,
    XYear: LongInt;
    YYear,
    YMonth,
    YDay: Integer;
     DT : TuDateTime;

  Begin
  Temp := (((JulianDN - D2) shl 2) - 1);
  XYear := (Temp Mod D1) or 3;
  JulianDN := Temp Div D1;
  YYear := (XYear Div D0);
  Temp := ((((XYear mod D0) + 4) shr 2) * 5) - 3;
  YMonth := Temp Div 153;
  If YMonth >= 10 Then
    Begin
    YYear := YYear + 1;
    YMonth := YMonth - 12;
    End;
  YMonth := YMonth + 3;
  YDay := Temp Mod 153;
  YDay := (YDay + 5) Div 5;

     DT.Year := YYear + (JulianDN * 100);
     DT.Month := YMonth;
     DT.Day := YDay;
     JulianToGregorian:=DT;
  End;
(**** end: private routines ****)

{$I beginudw.inc}

Function CalcDosPacked(const T: TuDateTime):tDosDate;
var
  Year  : UInt4;
begin
  Year:=t.Year;
  if Year>=1980 then begin
    Year:=Year-1980;
  end;
  CalcDosPacked:=(t.sec div 2) or {information is lost here!!}
          (t.min shl 5) or
          (t.hour shl 11) or
          (UInt4(t.day) shl 16) or
          (UInt4(t.month) shl 21) or
          (year shl 25);
end;

procedure UnpackDosDate(Date:TDosDate;var D:TuDateTime);
Type TLongRec=packed Record lo,hi:System.Word end;
begin
with d do
  begin
  sec:=(TLongRec(date).Lo and $1f)*2;  { $1f =31, we cover only 00..30}
  min:=(TLongRec(date).Lo shr 5)and $3f; { $3f = 63}
  hour:=(TLongRec(date).Lo shr 11);
  day:=(TLongRec(date).Hi)and $1f;
  month:=(TLongRec(date).Hi shr 5)and $f;
  year:=(TLongRec(date).Hi shr 9)+1980;

  // is there a y2k bug or why is this line contained here?
  If(year>=2028)then
    dec(year,28);
  end;
end;

Function GetDosDate:TDosDate;
Var
                       d: TuDateTime;
  {$IFDEF UseDummy}dummy: Word;{$ENDIF}
begin
  {$IFDEF PPC_Delphi}
    DeCodeDate(date,d.year,d.month,d.day);
    DecodeTime(time,D.Hour,D.Min,d.Sec{$IFDEF UseDummy},dummy{$ENDIF});
  {$ELSE}
    {$IFDEF PureDos}Dos.{$ENDIF}GetDate(D.Year, D.Month, D.Day {$IFDEF UseDummy}, dummy{$ENDIF});
    {$IFDEF PureDos}Dos.{$ENDIF}GetTime(D.Hour, D.Min, D.Sec {$IFDEF UseDummy}, dummy{$ENDIF});
  {$ENDIF}
  GetDosDate:=CalcDosPacked(D);
end;

Function GetTimeStamp: uint4;
Var Year,Month,Day,{$IFDEF UseDummy}Dummy,{$ENDIF}
    Hour,Minute,Second,Sec100:Word;
begin

{$IFDEF PPC_Delphi}
DeCodeDate(date,year,month,day);
DecodeTime(time,Hour,Minute,Second,Sec100);
{$ELSE}
GetDate(Year,Month,Day{$IFDEF UseDummy},Dummy{$ENDIF});
{$IFDEF PureDos}Dos.{$ENDIF}GetTime(Hour,Minute,Second{$IFDEF UseDummy},Sec100{$ENDIF});
{$IFNDEF UseDummy}Sec100:=0;{$ENDIF}
{$ENDIF}
GetTimeStamp:=((Sec100*44) div 100)+44*Longint(Second+60*Longint(Minute+
   60*Longint(Hour+24*Longint((Day-1)+31*Longint((Month-1)+12*Longint((Year-1999)mod 3))))));
End;

Function DateDiff(Date1, Date2: TDosDate): Integer;
var
  diff,
  d1, d2 : LongInt;
begin
  d1:=DosDateToUnixDate(Date1);
  d2:=DosDateToUnixDate(Date2);
  diff:=d1-d2;
  DateDiff:=(d1-d2) div (60*60*24);
end;

{$I endudw.inc}

Function ConvertToDateStr(dosDate:TDosDate):TDateTimeStr;
var
  d:TuDateTime;
begin
  UnPackDosDate(dosDate,d);
  ConvertToDateStr:=get2d(d.day)+'.'+getmonthstr(d.month)+' '+get2d(d.year div 100)+get2d(d.year mod 100);
end;

Function ConvertToTimeStr(dosDate:TDosDate):TDateTimeStr;
var
  d:TuDateTime;
begin
  UnPackDosDate(dosDate,d);
  ConvertToTimeStr:=get2d(d.hour)+':'+get2d(d.min)+':'+get2d(d.sec);
end;


function Convert_DosDateTime_To_DateTimeStr(const DateInfo, TimeInfo: TDosDate): TDateTimeStr;
begin
  Convert_DosDateTime_To_DateTimeStr:=ConvertToDateStr(DateInfo)+'  '+ConvertToTimeStr(TimeInfo);
end;

Function GetDOWStr(Dow: Word): ShortString;
  Begin
  Case DOW Of
    0: GetDOWStr := 'Sunday';
    1: GetDOWStr := 'Monday';
    2: GetDOWStr := 'Tuesday';
    3: GetDOWStr := 'Wednesday';
    4: GetDOWStr := 'Thursday';
    5: GetDOWStr := 'Friday';
    6: GetDOWStr := 'Saturday';
    Else
      GetDOWStr := '?????';
    End;
  End;


Function GetDOW3Str(DOW: Word): ShortString;
  Begin
  GetDOW3Str := Copy(GetDOWStr(Dow),1,3);
  End;


Function GetMonthStr(MonthNo:Word):ShortString;
begin
  if (MonthNo<13) and (MonthNo>0) then GetMonthStr:=Months[MonthNo]
                                  else GetMonthStr:='???';
end;

Procedure GetPKTTime(const SDate,STime:TDateTimeStr;
      var PKTStr:TString;var DosDate:TDosDate);
var d:TuDateTime;
begin
with d do
  begin
  Year:=StrToLong(Copy(SDate,7,2));
  If Year > 89 Then
    Inc(Year, 1900)
   else
    Inc(Year, 2000);
  Month:=StrToLong(Copy(SDate,4,2));
  Day:=StrToLong(Copy(SDate,1,2));
  Hour:=StrToLong(Copy(STime,1,2));
  Min:=StrToLong(Copy(STime,4,2));
  Sec:=StrToLong(Copy(STime,7,2));
  end;
PKTStr:=Copy(SDate,1,2)+' '+GetMonthStr(d.Month)+' '+Copy(SDate,7,2)+'  '+STime;
DosDate:=CalcDosPacked(d);
end;

Function DateTimeStr(DosDate:TDosDate):TDateTimeStr;
var d:TuDateTime;
begin
UnPackDosDate(dosDate,d);
With d do
  DateTimeStr:=Get2d(day)+'.'+GetMonthStr(month)+' '+
               get2d(year div 100)+get2d(year mod 100)+'  '+
               Get2d(hour)+':'+Get2d(min)+':'+Get2d(sec);
end;

Function CutForPKT(const DT:TDateTimeStr):TPKTDateTimeStr;
begin
CutForPKT:=Copy(DT,1,2)+' '+Copy(dt,4,4)+Copy(DT,10,12);
end;

Function PktDateTimeStrToDateTimeStr(const s: TPktDateTimeStr): TDateTimeStr;
var
  res : TDateTimeStr;
  year: Word;
  century: string;
begin
  res:=s;
  res[3]:='.';
  year:=StrToInt(copy(s,8,2));
  if year<80 then begin
    century:='20'
  end else begin
    century:='19';
  end;
  PktDateTimeStrToDateTimeStr:=copy(res,1,7)+century+copy(res,8,255);
end;

function MonthStrToInt(str: string): Integer;
var
  Month: Integer;
begin
  Case UpCase(str[1]) of
    'A':If UpCase(str[2])='P' then Month:=4 else Month:=8;
    'D':month:=12;
    'F':Month:=2;
    'J':If UpCase(str[2])='A' then month:=1 else
          If UpCase(str[3])='N' then month:=6 else month:=7;
    'M':If UpCase(str[3])='R' then Month:=3 else Month:=5;
    'N':Month:=11;
    'O':Month:=10;
    'S':Month:=9;
    else Month:=1;{$IFDEF UseErrDlg}InternalError($7403);{$ENDIF}
  end;
  MonthStrToInt:=Month;
end;

Function PackDateTime(const dt:TDateTimeStr):TDosDate;
var d:TuDateTime;
begin
with d do
  begin
  Year:=StrToLong(Copy(dt,8,4));
  Month:=MonthStrToInt(copy(dt,4,3));
  Day:=StrToLong(Copy(dt,1,2));
  Hour:=StrToLong(Copy(dt,14,2));
  Min:=StrToLong(Copy(dt,17,2));
  Sec:=StrToLong(Copy(dt,20,2));
  end;
PackDateTime:=CalcDosPacked(d);
end;

Function Convert_MMDDYYTime_To_DateTimeStr(const MMDDYY, Time: String): TDateTimeStr;
var
  D, M, Y : Word;
  TmpS    : String;
begin
  D:=StrToLong(copy(MMDDYY,4,2));
  M:=StrToLong(copy(MMDDYY,1,2));
  Y:=StrToLong(copy(MMDDYY,7,2));
  TmpS:=Get2d(D)+'.'+GetMonthStr(m)+' ';
  if y>=80 then begin
    TmpS:=TmpS+'19';
  end else begin
    TmpS:=TmpS+'20';
  end;
  Convert_MMDDYYTime_To_DateTimeStr:=TmpS+get2d(y mod 100)+'  '+Time;
end;

Function Convert_DMY_To_TDosDate(const DMY: string): TDosDate;
var
  strD, strM, strY: string;
  Point1, Point2  : Word;
  DT              : TuDateTime;
begin
  Point1:=Pos('.',DMY);
  Point2:=PosLastChar('.', DMY);
  strD:=Copy(DMY, 1, Point1-1);
  strM:=Copy(DMY, Point1+1, Point2-Point1-1);
  strY:=Copy(DMY, Point2+1, 255);

  FillChar(DT, SizeOf(DT), 0);
  DT.Day:=StrToInt(strD);
  DT.Month:=StrToInt(strM);
  DT.Year:=StrToInt(strY);

  // convert 2 digits to 4
  if DT.Year<80 then begin
    DT.Year:=DT.Year+2000;
  end else if DT.Year <100 then begin
    DT.Year:=DT.Year+1900;
  end;

  Convert_DMY_To_TDosDate:=CalcDosPacked(DT);
end;


Function Convert_DateTimeStr_To_MMDDYY(const DTStr: tDateTimeStr): string;
begin
  Convert_DateTimeStr_To_MMDDYY:=Get2D(MonthStrToInt(copy(DTStr,4,2)))+
                                 '-'+copy(DTStr,1,2)+
                                 '-'+copy(DTStr,10,2);
end; { Convert_DateTimeStr_To_MMDDYY }

Function FormattedDosDate(Const DosD: TDosDate; Mask: OpenString): TString;
  Var
    DStr    : String[2];
    DOWStr  : String[3];
    MStr    : String[2];
    MNStr   : String[3];
    YStr    : String[4];
    HourStr : String[2];
    MinStr  : String[2];
    SecStr  : String[2];
    CurrPos : Word;
    i       : Word;
     DT     : TuDateTime;

  Begin
  Mask := UpString(Mask);
  UnpackDosDate(DosD, DT);
  with DT do begin
    DStr := Copy(PadLeft(LongToStr(Day),'0',2),1,2);
    i:=GregorianToJulian(DT) mod 7+1;
    if i=7 then i:=0;
    DOWStr := GetDow3Str(i);
    MStr := Copy(PadLeft(LongToStr(Month),'0',2),1,2);
    YStr := Copy(PadLeft(LongToStr(Year),'0',4),1,4);
    HourStr := Copy(PadLeft(LongToStr(Hour),'0', 2),1,2);
    MinStr := Copy(PadLeft(LongToStr(Min), '0',2),1,2);
    SecStr := Copy(PadLeft(LongToStr(Sec), '0',2),1,2);
    MNStr := GetMonthStr(Month);
    end;
  If Pos('YYYY', Mask) = 0 Then
    YStr := Copy(YStr,3,2);
  CurrPos := Pos('DDD', Mask);
  If CurrPos > 0 Then
    For i :=1 to Length(DOWStr) Do
      Mask[CurrPos + pred(i)] := DowStr[i];
  CurrPos := Pos('DD', Mask);
  If CurrPos > 0 Then
    For i := 1 to Length(DStr) Do
      Mask[CurrPos + pred(i)] := DStr[i];
  CurrPos := Pos('YY', Mask);
  If CurrPos > 0 Then
    For i := 1 to Length(YStr) Do
      Mask[CurrPos + pred(i)] := YStr[i];
  CurrPos := Pos('NNN', Mask);
  if CurrPos=0 then CurrPos := Pos('MMM', Mask);
  If CurrPos > 0 Then
    For i := 1 to Length(MNStr) Do
      Mask[CurrPos + pred(i)] := MNStr[i];
  CurrPos := Pos('MM', Mask);
  If CurrPos > 0 Then
    For i := 1 to Length(MStr) Do
      Mask[CurrPos + pred(i)] := MStr[i];
  CurrPos := Pos('HH', Mask);
  If CurrPos > 0 Then
    For i := 1 to Length(HourStr) Do
      Mask[CurrPos + pred(i)] := HourStr[i];
  CurrPos := Pos('SS', Mask);
  If CurrPos > 0 Then
    For i := 1 to Length(SecStr) Do
      Mask[CurrPos + pred(i)] := SecStr[i];
  CurrPos := Pos('II', Mask);
  if CurrPos=0 then CurrPos := Pos('NN', Mask); { nn is used by SysUtils }
  If CurrPos > 0 Then
    For i := 1 to Length(MinStr) Do
      Mask[CurrPos + pred(i)] := MinStr[i];
  FormattedDosDate := Mask;
  End;


{private}
Function TuDateTimeToUnixDate(DT: TuDateTime): LongInt;
var
  SecsPast, DaysPast: System.LongInt;
begin
  DaysPast := GregorianToJulian(DT) - c1970;
  if (DaysPast < 0) or (dt.year > 2020) then begin
    // to ensure, that DaysPast is a bit valid...
    DaysPast:=0
  end;
  SecsPast := DaysPast * 86400;
  SecsPast := SecsPast + (System.LongInt(DT.Hour) * 3600) + (DT.Min * 60) + (DT.Sec);
  TuDateTimeToUnixDate := SecsPast;
end;

Function DosDateToUnixDate(FDate: TDosDate): LongInt;
var
   DT : TuDateTime;

begin
  UnpackDosDate(FDate, DT);
  DosDateToUnixDate:=TuDateTimeToUnixDate(DT);
end;

Function TDateTimeStrToUnixDate(const FDate: TDateTimeStr): LongInt;
begin
  TDateTimeStrToUnixDate:=DosDateToUnixDate(PackDateTime(FDate));
end;

Function UnixDateToDosDate(const unx : LongInt): TDosDate;
Var
   SecsPast,
  DateNum : LongInt;
   DT       : TuDateTime;

begin
  SecsPast:=unx;
  Datenum := (SecsPast Div 86400) + c1970;
  DT:=JulianToGregorian(DateNum);
  SecsPast := SecsPast Mod 86400;
  DT.Hour := SecsPast Div 3600;
  SecsPast := SecsPast Mod 3600;
  DT.Min := SecsPast Div 60;
  DT.Sec := SecsPast Mod 60;
  UnixDateToDosDate:=CalcDosPacked(DT);
end;


{code for testing packing and unpacking of dosdates}

(*
var
 p : array[1..2] of Longint;
 t : array[1..2] of TuDateTime;

begin
  with t[1] do begin
    Day:=1;
    Month:=2;
    Year:=2000;
    Hour:=21;
    Min:=26;
    Sec:=6;
  end;
  with t[2] do begin
    Day:=5;
    Month:=2;
    Year:=2000;
    Hour:=21;
    Min:=26;
    Sec:=6;
  end;
  p[1]:=CalcDosPacked(t[1]);
  p[2]:=CalcDosPacked(t[2]);
  WriteLn(DateDiff(p[2],p[1]));
(**)

End.