{               Copyright 1991 TechnoJock Software, Inc.               }
{                          All Rights Reserved                         }
{                         Restricted by License                        }

{                             Build # 1.00                             }

Unit totDATE;
{$I TOTFLAGS.INC}

{
 Development Notes:


}

INTERFACE

Uses DOS,totLOOK,totSTR;

Type

tDate = (MMDDYY,MMDDYYYY,MMYY,MMYYYY,DDMMYY,DDMMYYYY,YYMMDD,YYYYMMDD);
StrShort = string[20];

tMonths  = array[1..12] of StrShort;
tDays = array[0..6] of StrShort;

pDateOBJ = ^DateOBJ;
DateOBJ = object
   vLastYearNextCentury: byte;
   vSeparator: char;
   vMonths: tMonths;
   vDays: tDays;
   {methods...}
   constructor Init;
   procedure   SetLastYearNextCentury(Yr:byte);
   procedure   SetSeparator(Sep:char);
   procedure   SetMonths(Mth1,Mth2,Mth3,Mth4,Mth5,Mth6,Mth7,Mth8,Mth9,Mth10,Mth11,Mth12: strshort);
   procedure   SetDays(Day0,Day1,Day2,Day3,Day4,Day5,Day6:strshort);
   function    GetLastYearNextCentury: byte;
   function    GetSeparator: char;
   function    GetMonth(Mth:byte):string;
   function    GetDay(Day:byte):string;
   destructor  Done;
end; {DateOBJ}

function  GregtoJul(M,D,Y : longint): longint;
procedure JultoGreg(Jul:longint; var M,D,Y: longint);
function  Day(DStr:string;Format:tDate): word;
function  Month(DStr:string;Format:tDate): word;
function  Year(DStr:string;Format:tDate): word;
function  StrtoJul(DStr:string;Format:tDate):longint;
function  DOWStr(DStr:string;Format:tDate): byte;
function  DOWJul(Jul:longint): byte;
function  GregtoStr(M,D,Y:longint;Format:tDate): string;
function  JultoStr(Jul:longint;Format:tDate): string;
function  TodayinJul: longint;
function  ValidDate(M,D,Y:longint):boolean;
function  ValidDateStr(DStr:string;Format:tDate): boolean;
function  StripDateStr(DStr:string;Format:tDate):string;
function  FancyDateStr(Jul:longint; Long,Day:boolean): string;
function  RelativeDate(DStr:string;Format:tDate;Delta:longint):string;
function  StartOfYear(Jul:longint):longint;
function  EndOfYear(Jul:longint):longint;
function  DateFormat(Format:tDate):string;
procedure DateInit;

var

  DateTOT: ^DateOBJ;

IMPLEMENTATION

{|||||||||||||||||||||||||||||||||||||||}
{                                       }
{     D a t e O B J   M E T H O D S     }
{                                       }
{|||||||||||||||||||||||||||||||||||||||}
constructor DateOBJ.Init;
{}
begin
   vLastYearNextCentury := 20;
   vSeparator := '/';
   SetDays('Sunday','Monday','Tuesday','Wednesday',
           'Thursday','Friday','Saturday');
   SetMonths('January','February','March','April','May',
             'June','July','August','September',
             'October','November','December');
end; {DateOBJ.Init}

function DateOBJ.GetLastYearNextCentury: byte;
{}
begin
   GetLastYearNextCentury := vLastYearNextCentury;
end; {DateOBJ.GetLastYearNextCentury}

procedure DateOBJ.SetLastYearNextCentury(Yr:byte);
{}
begin
   {$IFDEF CHECK}
     if (Yr >= 0) and (Yr <= 99) then
        vLastYearNextCentury := Yr;
   {$ELSE}
     vLastYearNextCentury := Yr;
   {$ENDIF}
end; {DateOBJ.GetLastYearNextCentury}

function DateOBJ.GetSeparator: char;
{}
begin
   GetSeparator := vSeparator;
end; {DateOBJ.GetSeparator}

procedure DateOBJ.SetSeparator(Sep:char);
{}
begin
   vSeparator := Sep;
end; {DateOBJ.SetSeparator}

procedure DateOBJ.SetMonths(Mth1,Mth2,Mth3,Mth4,Mth5,Mth6,Mth7,Mth8,Mth9,Mth10,Mth11,Mth12: StrShort);
{}
begin
   vMonths[1] := Mth1;
   vMonths[2] := Mth2;
   vMonths[3] := Mth3;
   vMonths[4] := Mth4;
   vMonths[5] := Mth5;
   vMonths[6] := Mth6;
   vMonths[7] := Mth7;
   vMonths[8] := Mth8;
   vMonths[9] := Mth9;
   vMonths[10] := Mth10;
   vMonths[11] := Mth11;
   vMonths[12] := Mth12;
end; {DateOBJ.SetMonths}

procedure DateOBJ.SetDays(Day0,Day1,Day2,Day3,Day4,Day5,Day6:StrShort);
{}
begin
   vDays[0] := Day0;
   vDays[1] := Day1;
   vDays[2] := Day2;
   vDays[3] := Day3;
   vDays[4] := Day4;
   vDays[5] := Day5;
   vDays[6] := Day6;
end; {DateOBJ.SetDays}

function DateOBJ.GetMonth(Mth:byte):string;
{}
begin
   if Mth in [2..12] then
      GetMonth := vMonths[Mth]
   else
      GetMonth := vMonths[1];
end; {DateOBJ.GetMonth}

function DateOBJ.GetDay(Day:byte):string;
{}
begin
   if Day in [1..6] then
      GetDay := vDays[Day]
   else
      GetDay := vDays[0];
end; {DateOBJ.GetDay}

destructor DateOBJ.Done;
begin end;
{|||||||||||||||||||||||||||||||||||||||||||}
{                                           }
{     M i s c   P r o c   &   F u n c s     }
{                                           }
{|||||||||||||||||||||||||||||||||||||||||||}
function PadDateStr(DStr:string;Format:tDate):string;
{}
var
   Part1,Part2,Part3: string;
   L,P: byte;
   Sep1,Sep2:char;

     procedure PadOut(var S:string; width:byte);
     begin
        S := padright(S,width,'0');
     end;

begin
   if length(DStr) = length(DateFormat(Format)) then
   begin
      PadDateStr := DStr;
      exit;
   end;
   P := 0;
   L := length(DStr);
   repeat
      inc(P);
   until (not (DStr[P] in ['0'..'9'])) or (P > L);
   if P > L then
   begin
      PadDateStr := DStr;
      exit;
   end;
   Part1 := copy(DStr,1,pred(P));
   Sep1 := DStr[P];
   delete(DStr,1,P);
   P:= 0;
   repeat
      inc(P);
   until (not (DStr[P] in ['0'..'9'])) or (P > L);
   Part2 := copy(DStr,1,pred(P));
   Sep2 := DStr[P];
   Part3 := copy(DStr,succ(P),4);
   case Format of
      MMDDYY,YYMMDD,DDMMYY:begin
          PadOut(Part1,2);
          PadOut(Part2,2);
          PadOut(Part3,2);
          DStr := Part1+Sep1+Part2+Sep2+Part3;
      end;
      MMDDYYYY,DDMMYYYY:begin
          PadOut(Part1,2);
          PadOut(Part2,2);
          PadOut(Part3,4);
          DStr := Part1+Sep1+Part2+Sep2+Part3;
      end;
      YYYYMMDD:begin
          PadOut(Part1,4);
          PadOut(Part2,2);
          PadOut(Part3,2);
          DStr := Part1+Sep1+Part2+Sep2+Part3;
      end;
      MMYY:begin
          PadOut(Part1,2);
          PadOut(Part2,2);
          DStr := Part1+Sep1+Part2;
      end;
      MMYYYY:begin
          PadOut(Part1,2);
          PadOut(Part2,4);
          DStr := Part1+Sep1+Part2;
      end;
   end; {case}
   PadDateStr := DStr;
end; {PadDateStr}

function GregtoJul(M,D,Y:longint):longint;
{}
var Factor: integer;
begin
   if M < 3 then
      Factor := -1
   else
      Factor := 0;
   GregtoJul :=  (1461*(Factor+4800+Y) div 4)
               + ((M-2-(Factor*12))*367) div 12
               - (3*((Y+4900+Factor) div 100) div 4)
               + D
               - 32075;
end; {GregtoJul}

procedure JultoGreg(Jul:longint; var M,D,Y: longint);
{}
var U,V,W,X: longint;
begin
   inc(Jul,68569);
   W := (Jul*4) div 146097;
   dec(Jul,((146097*W)+3) div 4);
   X := 4000*succ(Jul) div 1461001;
   dec(Jul,((1461*X) div 4) - 31);
   V := 80*Jul div 2447;
   U := V div 11;
   D := Jul - (2447*V div 80);
   M := V + 2 - (U*12);
   Y := X + U + (W-49)*100;
end; {JultoGreg}

function Day(DStr:string;Format:tDate): word;
{}
var
   DayStr: string;
begin
   DStr := PadDateStr(DStr,Format);
   case Format of
      MMDDYY,
      MMDDYYYY: DayStr := NthNumber(DStr,3)+NthNumber(DStr,4);
      DDMMYY,
      DDMMYYYY: DayStr := NthNumber(DStr,1)+NthNumber(DStr,2);
      YYMMDD:   DayStr := NthNumber(DStr,5)+NthNumber(DStr,6);
      YYYYMMDD: DayStr := NthNumber(DStr,7)+NthNumber(DStr,8);
      else     DayStr := '01';
   end; {case}
   Day := StrToInt(DayStr);
end; {Day}

function Month(DStr:string;Format:tDate): word;
{}
var
   MonStr: string;
begin
   DStr := PadDateStr(DStr,Format);
   case Format of
      MMDDYY,
      MMDDYYYY,
      MMYY,
      MMYYYY  :  MonStr := NthNumber(DStr,1)+NthNumber(DStr,2);
      YYMMDD,
      DDMMYY,
      DDMMYYYY:  MonStr := NthNumber(DStr,3)+NthNumber(DStr,4);
      YYYYMMDD:  MonStr := NthNumber(DStr,5)+NthNumber(DStr,6);
   end; {case}
   Month := StrToInt(MonStr);
end; {Month}

function Year(DStr:string;Format:tDate): word;
{}
var
   YrStr: string;
   TmpYr: word;
begin
   DStr := PadDateStr(DStr,Format);
   Case Format of
      MMDDYY,
      DDMMYY   : YrStr := NthNumber(DStr,5)+NthNumber(DStr,6);
      MMDDYYYY,
      DDMMYYYY : YrStr := NthNumber(DStr,5)+NthNumber(DStr,6)
                          + NthNumber(DStr,7)+NthNumber(DStr,8);
      MMYY     : YrStr := NthNumber(DStr,3)+NthNumber(DStr,4);
      MMYYYY   : YrStr := NthNumber(DStr,3)+NthNumber(DStr,4)
                          + NthNumber(DStr,5)+NthNumber(DStr,6);
      YYMMDD   : YrStr := NthNumber(DStr,5)+NthNumber(DStr,6);
      YYYYMMDD : YrStr := NthNumber(DStr,1)+NthNumber(DStr,2)
                          + NthNumber(DStr,3)+NthNumber(DStr,4);
   end;
   TmpYr := StrToInt(YrStr);
   if (TmpYr >= 0) and (TmpYr <= 99) then
   begin
      if TmpYr < DateTOT^.GetLastYearNextCentury then
         TmpYr := 2000 + TmpYr
      else
         TmpYr := 1900 + TmpYr;
   end;
   Year := TmpYr;
end; {Year}

function GregtoStr(M,D,Y:longint;Format:tDate): string;
{}
var
   PadChar : char;
   DD,MM: string[2];
   YY: string[4];
begin
   PadChar := DateTOT^.GetSeparator;
   DD := InttoStr(D);
   if D < 10 then
      DD := '0'+DD;
   MM := InttoStr(M);
   if M < 10 then
      MM := '0'+MM;
   if (Format in [MMDDYY,MMYY,DDMMYY,YYMMDD])
   and ((Y > 99) or (Y < -99)) then
      Y := Y Mod 100;
   YY := InttoStr(Y);
   if Y < 10 then
      YY := '0'+YY;
   Case Format of
      MMDDYY,
      MMDDYYYY: GregtoStr := MM+PadChar+DD+Padchar+YY;
      MMYY,
      MMYYYY  : GregtoStr := MM+Padchar+YY;
      DDMMYY,
      DDMMYYYY: GregtoStr := DD+PadChar+MM+Padchar+YY;
      YYMMDD,
      YYYYMMDD: GregtoStr := YY+PadChar+MM+Padchar+DD;
   end; {case}
end; {GregtoStr}

function JultoStr(Jul:longint;Format:tDate): string;
{}
var M,D,Y:longint;
begin
   JultoGreg(Jul,M,D,Y);
   JultoStr := GregtoStr(M,D,Y,Format);
end; {JultoStr}

function TodayinJul: longint;
{}
var 
 M,D,Y,DOW: word;
begin
   GetDate(Y,M,D,DOW);
   TodayinJul := GregtoJul(M,D,Y);
end; {TodayinJul}

function ValidDate(M,D,Y:longint):boolean;
{}
begin
   if (D < 1)
   or (D > 31)
   or (M < 1)
   or (M > 12)
   then 
      ValidDate := False
   else
      Case M of
         4,6,9,11: ValidDate := (D <= 30);
         2:        ValidDate := (D <= 28)
                                or ( (D = 29)
                                     and (Y <> 1900) 
                                     and (Y <> 0)
                                     and (Y mod 4 = 0)
                                    );
          else ValidDate := true;
      end; {case}
end; {ValidDate}

function  ValidDateStr(DStr:string;Format:tDate): boolean;
{}
var
 M,D,Y: word;
begin
   M := Month(DStr,Format);
   D := Day(DStr,Format);
   Y := Year(DStr,Format);
   ValidDateStr := ValidDate(M,D,Y);
end; {ValidDateStr}

function DOWJul(Jul:longint): byte;
var M,D,Y,N: longint;
begin
   JultoGreg(Jul,M,D,Y);
   if M <=2 then
     N := 1461 * (Y-1) div 4 + 153 * (M+13) div 5 + D
   else
     N := 1461 * Y div 4 + 153 * (M+1) div 5 + D;
   N:= abs((N - 621049)) mod 7;
   DOWJul := N;
end; {DayOfWeek}

function StrtoJul(DStr:string;Format:tDate):longint;
{}
var
  M,D,Y:longint;
begin
   M := Month(Dstr,Format);
   D := Day(Dstr,Format);
   Y := Year(Dstr,Format);
   StrtoJul := GregtoJul(M,D,Y);
end; {StrtoJul}

function DOWStr(DStr:string;Format:tDate): byte;
{}
begin
   DOWStr := DOWJul(StrtoJul(Dstr,Format));
end; {DOWStr}

function StripDateStr(DStr:string;Format:tDate):string;
{}
begin
   case Format of
      MMDDYY,
      MMDDYYYY,
      DDMMYY,
      DDMMYYYY,
      YYMMDD: begin
                 delete(Dstr,3,1);
                 delete(Dstr,5,1);
              end;
      MMYY,
      MMYYYY  : delete(DStr,3,1);
      YYYYMMDD: begin
                  delete(DStr,5,1);
                  delete(DStr,7,1);
                end;
   end; {case}
   StripDateStr := DStr;
end; {StripDateStr}

function FancyDateStr(Jul:longint; Long,Day:boolean): string;
{}
var 
  M,D,Y:longint;
  TheDay: byte;
  Str: string;
begin
   JultoGreg(Jul,M,D,Y);
   Str := ' '+InttoStr(D)+', '+IntToStr(Y);
   if Long then
      Str := dateTOT^.GetMonth(M) + Str
   else
      Str := copy(dateTOT^.GetMonth(M),1,3) + Str;
   if Day then
   begin
      TheDay := DOWJul(Jul);
      if Long then
         Str := dateTOT^.GetDay(TheDay) + ' ' + Str
      else
         Str := copy(dateTOT^.GetDay(TheDay),1,3) + ' ' + Str;
   end;
   FancyDateStr := Str;
end; {FancyDateStr}

function RelativeDate(DStr:string;Format:tDate;Delta:longint):string;
{}
begin
   RelativeDate := JultoStr(StrtoJul(DStr,Format)+Delta,Format);
end; {RelativeDate}

function EndOfMonth(Jul:longint):longint;
{}
var M,D,Y:longint;
begin
   JultoGreg(Jul,M,D,Y);
   case M of
      4,6,9,11: D := 30;
      2: if (Y mod 4 = 0) and (Y <> 0) and (Y <> 1900) then
            D := 29
         else
            D := 28;
      else D := 31;
   end; {case}
   EndOfMonth := GregtoJul(M,D,Y);
end; {EndOfMonth}

function StartOfMonth(Jul:longint):longint;
{}
var M,D,Y:longint;
begin
   JultoGreg(Jul,M,D,Y);
   StartOfMonth := GregtoJul(M,1,Y);
end; {StartOfMonth}

function StartOfYear(Jul:longint):longint;
{}
var M,D,Y:longint;
begin
   JultoGreg(Jul,M,D,Y);
   StartOfYear := GregtoJul(1,1,Y);
end; {StartOfYear}

function EndOfYear(Jul:longint):longint;
{}
var M,D,Y:longint;
begin
   JultoGreg(Jul,M,D,Y);
   EndOfYear := GregtoJul(12,31,Y);
end; {EndOfYear}

function DateFormat(Format:tDate):string;
{}
var Sep:char;
begin
   Sep := DateTOT^.GetSeparator;
   Case Format of
      MMDDYY: DateFormat := 'MM'+Sep+'DD'+Sep+'YY';
      MMDDYYYY: DateFormat := 'MM'+Sep+'DD'+Sep+'YYYY';
      MMYY: DateFormat := 'MM'+Sep+'YY';
      MMYYYY: DateFormat := 'MM'+Sep+'YYYY';
      DDMMYY: DateFormat := 'YY'+Sep+'MM'+Sep+'YY';
      DDMMYYYY: DateFormat := 'DD'+Sep+'MM'+Sep+'YYYY';
      YYMMDD: DateFormat := 'YY'+Sep+'MM'+Sep+'DD';
      YYYYMMDD: DateFormat :=  'YYYYY'+Sep+'MM'+Sep+'DD';
   end; {case}
end; {DateFormat}
{|||||||||||||||||||||||||||||||||||||||||||||||}
{                                               }
{     U N I T   I N I T I A L I Z A T I O N     }
{                                               }
{|||||||||||||||||||||||||||||||||||||||||||||||}

procedure DateInit;
{initilizes objects and global variables}
begin
   new(DateTOT,Init);
end; {DateInit}

{end of unit - add initialization routines below}
{$IFNDEF OVERLAY}
begin
   DateInit;
{$ENDIF}
end.