[Back to DATETIME SWAG index]  [Back to Main SWAG index]  [Original]

{
VINCE LAURENT

> Does anyone have a fast function for sorting two dates?
> Something like function SortDate(Date1, Date2 : string): integer;
> Strings would be in the format of '1/1/94' etc.

Convert the dates to Julian Dates first...then you can do with them
what you want.  Here is a unit I got a long time ago...
}

UNIT Julian;
{
////////////////////////////////////////// DEMO Routines
/Begin
/  ClrScr;
/  GetDate(Year,Month,Day,Dow);

/  WriteLn('Year  : ',Year);
/  WriteLn('Month : ',Month);
/  WriteLn('Day   : ',Day);
/  WriteLn('DOW   : ',Dow);
/  WriteLn(MachineDate);
/  JulianDate := DateToJulian(MachineDate);
/  WriteLn('Julian Date = ',JulianDate);
/  WriteLn('Jul To Date = ',JulianToDate(JulianDate));
/  WriteLn('Day Of Week = ',DayOfWeek(JulianDate));
/  WriteLn('Time        = ',MachineTime(4));
/End.
///////////////////////////////////////////////////////////////
}
INTERFACE

Uses
  Crt, Dos;

Type
  Str3  = String[3];
  Str8  = String[8];
  Str9  = String[9];
  Str11 = String[11];

Var
  Hour,
  Minute,
  Second,
  S100,
  Year,
  Month,
  Day,
  Dow        : Word;
  Syear,
  Smonth,
  Sday,
  Sdow       : String;
  JulianDate : Integer;

Function  MachineTime(Len : Byte) : Str11;
Function  MachineDate : Str8;
Function  DateFactor(MonthNum, DayNum, YearNum : Real) : Real;
Function  DateToJulian(DateLine : Str8) : Integer;
Function  JulianToDate(DateInt : Integer): Str11;
Function  JulianToStr8(DateInt : Integer): Str8;
Function  DayofWeek(Jdate : Integer) : Str3;
Procedure DateDiff(Date1,Date2 : Integer; VAR Date_Difference : Str9);

IMPLEMENTATION

Function MachineTime(Len : Byte) : Str11;
Var
  I       : Byte;
  TempStr : String;
  TimeStr : Array[1..4] Of String;

Begin
  TempStr := '';
  FillChar(TimeStr, SizeOf(TimeStr),0);
  GetTime(Hour, Minute, Second, S100);
  Str(Hour, TimeStr[1]);
  Str(Minute, TimeStr[2]);
  Str(Second, TimeStr[3]);
  Str(S100, TimeStr[4]);
  TempStr := TimeStr[1];
  For I := 2 To Len Do
    TempStr := TempStr + ':' + TimeStr[I];
  MachineTime := TempStr;
End;

Function MachineDate : Str8;
Begin
  GetDate(Year, Month, Day, Dow);
  Str(Year, Syear);
  Str(Month, Smonth);
  If Month < 10 Then
    Smonth := '0' + Smonth;
  Str(Day,Sday);
  If Day < 10 Then
    Sday := '0' + Sday;
  MachineDate := smonth + sday + syear;
End;

Function DateFactor(MonthNum, DayNum, YearNum : Real) : Real;
Var
  Factor : Real;
Begin
  Factor := (365 * YearNum) + DayNum + (31 * (MonthNum - 1));
  If MonthNum < 3 Then
    Factor :=  Factor + Int((YearNum-1) / 4) -
               Int(0.75 * (Int((YearNum-1) / 100) + 1))
  Else
    Factor :=  Factor - Int(0.4 * MonthNum + 2.3) + Int(YearNum / 4) -
               Int(0.75 * (Int(YearNum / 100) + 1));
  DateFactor := Factor;
End;

Function DateToJulian(DateLine : Str8) : Integer;
Var
  Factor,
  MonthNum,
  DayNum,
  YearNum : Real;
  Ti      : Integer;
Begin
  If Length(DateLine) = 7 Then
    DateLine := '0' + DateLine;
  MonthNum := 0.0;
  For Ti := 1 to 2 Do
    MonthNum := (10 * MonthNum) + (Ord(DateLine[Ti])-Ord('0'));
  DayNum := 0.0;
  For Ti := 3 to 4 Do
    DayNum := (10 * DayNum) + (Ord(DateLine[Ti])-Ord('0'));
  YearNum := 0.0;
  For Ti := 5 to 8 Do
    YearNum := (10 * YearNum) + (Ord(DateLine[Ti])-Ord('0'));
  Factor := DateFactor(MonthNum, DayNum, YearNum);
  DateToJulian := Trunc((Factor - 679351.0) - 32767.0);
End;

Function JulianToDate(DateInt : Integer): Str11;
Var
  holdstr,
  strDay   : string[2];
  anystr   : string[11];
  StrMonth : string[3];
  stryear  :  string[4];
  test,
  error,
  Year,
  Dummy, I : Integer;
  Save,
  Temp     : Real;
  JulianToanystring : Str11;
Begin
  holdstr := '';
  JulianToanystring := '00000000000';
  Temp  := Int(DateInt) + 32767 + 679351.0;
  Save  := Temp;
  Dummy := Trunc(Temp/365.5);

  While Save >= DateFactor(1.0,1.0,Dummy+0.0) Do
    Dummy := Succ(Dummy);
  Dummy := Pred(Dummy);
  Year  := Dummy;
  (* Determine number Of Days into current year *)
  Temp  := 1.0 + Save - DateFactor(1.0,1.0,Year+0.0);
  (* Put the Year into the output string *)
  For I := 8 downto 5 Do
  Begin
    JulianToanystring[I] := Char((Dummy mod 10) + Ord('0'));
    Dummy := Dummy div 10;
  End;
  Dummy := 1 + Trunc(Temp/31.5);
  While Save >= DateFactor(Dummy+0.0,1.0,Year+0.0) Do
    Dummy := Succ(Dummy);
  Dummy := Pred(Dummy);
  Temp  := 1.0 + Save - DateFactor(Dummy+0.0,1.0,Year+0.0);
  For I := 2 Downto 1 Do
  Begin
    JulianToanystring[I] := Char((Dummy mod 10)+Ord('0'));
    Dummy := Dummy div 10;
  End;
  Dummy := Trunc(Temp);

  For I := 4 Downto 3 Do
  Begin
    JulianToanystring[I] := Char((Dummy mod 10)+Ord('0'));
    Dummy := Dummy div 10;
  End;
  holdstr := copy(juliantoanystring,1,2);
  val(holdstr, test, error);
  Case test Of
    1 : StrMonth := 'Jan';
    2 : StrMonth := 'Feb';
    3 : StrMonth := 'Mar';
    4 : StrMonth := 'Apr';
    5 : StrMonth := 'May';
    6 : StrMonth := 'Jun';
    7 : StrMonth := 'Jul';
    8 : StrMonth := 'Aug';
    9 : StrMonth := 'Sep';
   10 : StrMonth := 'Oct';
   11 : StrMonth := 'Nov';
   12 : StrMonth := 'Dec';
  End;
  stryear := copy(juliantoanystring, 5, 4);
  strDay  := copy(juliantoanystring, 3, 2);
  anystr  := StrDay + '-' + StrMonth + '-' +stryear;
  JulianToDate := anystr;
End;

Function JulianToStr8(DateInt : Integer): Str8;
Var
  holdstr,
  StrMonth,
  strDay   : string[2];
  anystr   : string[8];
  stryear  : string[4];
  test,
  error,
  Year,
  Dummy,
  I       : Integer;
  Save,
  Temp    : Real;
  JulianToanystring : Str8;
Begin
  holdstr := '';
  JulianToanystring := '00000000';
  Temp  := Int(DateInt) + 32767 + 679351.0;
  Save  := Temp;
  Dummy := Trunc(Temp/365.5);
  While Save >= DateFactor(1.0,1.0,Dummy+0.0) Do
    Dummy := Succ(Dummy);
  Dummy := Pred(Dummy);
  Year  := Dummy;
  (* Determine number Of Days into current year *)
  Temp  := 1.0 + Save - DateFactor(1.0,1.0,Year+0.0);
  (* Put the Year into the output string *)
  For I := 8 downto 5 Do
  Begin
    JulianToanystring[I] := Char((Dummy mod 10)+Ord('0'));
    Dummy := Dummy div 10;
  End;
  Dummy := 1 + Trunc(Temp/31.5);
  While Save >= DateFactor(Dummy+0.0,1.0,Year+0.0) Do
    Dummy := Succ(Dummy);
  Dummy := Pred(Dummy);
  Temp  := 1.0 + Save - DateFactor(Dummy+0.0,1.0,Year+0.0);
  For I := 2 Downto 1 Do
  Begin
    JulianToanystring[I] := Char((Dummy mod 10)+Ord('0'));
    Dummy := Dummy div 10;
  End;
  Dummy := Trunc(Temp);

  For I := 4 Downto 3 Do
  Begin
    JulianToanystring[I] := Char((Dummy mod 10)+Ord('0'));
    Dummy := Dummy div 10;
  End;

  holdstr := copy(juliantoanystring,1,2);
  val(holdstr, test, error);
  Case test Of
    1 : StrMonth := '01';
    2 : StrMonth := '02';
    3 : StrMonth := '03';
    4 : StrMonth := '04';
    5 : StrMonth := '05';
    6 : StrMonth := '06';
    7 : StrMonth := '07';
    8 : StrMonth := '08';
    9 : StrMonth := '09';
   10 : StrMonth := '10';
   11 : StrMonth := '11';
   12 : StrMonth := '12';
  End;
  StrYear := copy(juliantoanystring, 5, 4);
  StrDay  := copy(juliantoanystring, 3, 2);
  AnyStr  := StrMonth + StrDay + StrYear;
  JulianToStr8 := AnyStr;
End;

Function DayofWeek(Jdate : Integer) : Str3;
Begin
  Case jdate MOD 7 Of
    0 : DayofWeek := 'Sun';
    1 : DayofWeek := 'Mon';
    2 : DayofWeek := 'Tue';
    3 : DayofWeek := 'Wed';
    4 : DayofWeek := 'Thu';
    5 : DayofWeek := 'Fri';
    6 : DayofWeek := 'Sat';
  End;
End;

Procedure DateDiff(Date1, Date2 : Integer; Var Date_Difference : Str9);
VAR
 Temp,
 Rdate1,
 Rdate2,
 Diff1  : Real;
 Diff   : Integer;
 Return : String[9];
 Hold   : String[3];
Begin
  Rdate2 := Date2 + 32767.5;
  Rdate1 := Date1 + 32767.5;
  Diff1  := Rdate1 - Rdate2;
  Temp   := Diff1;
  If Diff1 < 32 Then (* determine number of Days *)
  Begin
    Diff := Round(Diff1);
    Str(Diff,Hold);
    Return := Hold + ' ' + 'Day';
    If Diff > 1 Then
      Return := Return + 's  ';
  End;
  If ((Diff1 > 31) And (Diff1 < 366)) Then
  Begin
    Diff1 := Diff1 / 30;
    Diff  := Round(Diff1);
    Str(Diff,Hold);
    Return := Hold + ' ' + 'Month';
    If Diff > 1 Then
      Return := Return + 's';
  End;
  If Diff1 > 365 Then
  Begin
    Diff1 := Diff1 / 365;
    Diff  := Round(Diff1);

    Str(Diff,Hold);
    Return := Hold;
  End;
  Date_Difference := Return;
  Diff := Round(Diff1);
End;

END.



[Back to DATETIME SWAG index]  [Back to Main SWAG index]  [Original]