Unit m_DateTime;
{$I M_OPS.PAS}
Interface
Const
DayString : Array[0..6] of String[3] = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
MonthString : Array[1..12] of String[3] = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
Procedure WaitMS (MS: Word);
Function TimerMinutes : LongInt;
Function TimerSeconds : LongInt;
Function TimerSet (Secs: LongInt) : LongInt;
Function TimerUp (Secs: LongInt) : Boolean;
Function CurDateDos : LongInt;
Function CurDateJulian : LongInt;
Function DateDos2Str (Date: LongInt; Format: Byte) : String;
Function DateJulian2Str (Date: LongInt; Format: Byte) : String;
Function DateStr2Dos (Str: String) : LongInt;
Function DateStr2Julian (Str: String) : LongInt;
Procedure DateG2J (Year, Month, Day: LongInt; Var Julian: LongInt);
Procedure DateJ2G (Julian: LongInt; Var Year, Month, Day: SmallInt);
Function DateValid (Str: String) : Boolean;
Function TimeDos2Str (Date: LongInt; Mode: Byte) : String;
Function DayOfWeek (Date: LongInt) : Byte;
Function DaysAgo (Date: LongInt; dType: Byte) : LongInt;
Function TimeSecToStr (Secs: LongInt) : String;
Implementation
Uses
{$IFDEF WINDOWS}
Windows,
{$ENDIF}
{$IFDEF UNIX}
BaseUnix,
{$ENDIF}
DOS,
m_Strings;
Const
JulianDay0 = 1461;
JulianDay1 = 146097;
JulianDay2 = 1721119;
Function TimeSecToStr (Secs: LongInt) : String;
Var
Mins,
Hours : LongInt;
Begin
Mins := Secs DIV 60;
Hours := Mins DIV 60;
Mins := Mins MOD 60;
Result := strZero(Hours) + ':' + strZero(Mins);
End;
Procedure WaitMS (MS: Word);
Begin
{$IFDEF WIN32}
Sleep(MS);
{$ENDIF}
{$IFDEF UNIX}
fpSelect(0, Nil, Nil, Nil, MS);
{$ENDIF}
End;
Procedure DateG2J (Year, Month, Day: LongInt; Var Julian: LongInt);
Var
Century : LongInt;
XYear : LongInt;
Begin
If Month <= 2 Then Begin
Dec (Year);
Inc (Month, 12);
End;
Dec (Month, 3);
Century := Year DIV 100;
XYear := Year MOD 100;
Century := (Century * JulianDay1) SHR 2;
XYear := (XYear * JulianDay0) SHR 2;
Julian := ((((Month * 153) + 2) DIV 5) + Day) + JulianDay2 + XYear + Century;
End;
Procedure DateJ2G (Julian: LongInt; Var Year, Month, Day: SmallInt);
Var
Temp : LongInt;
XYear : LongInt;
YYear : LongInt;
YMonth : LongInt;
YDay : LongInt;
Begin
Temp := (((Julian - JulianDay2) SHL 2) - 1);
XYear := (Temp MOD JulianDay1) OR 3;
Julian := Temp DIV JulianDay1;
YYear := (XYear DIV JulianDay0);
Temp := ((((XYear MOD JulianDay0) + 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;
Year := YYear + (Julian * 100);
Month := YMonth;
Day := YDay;
End;
Function CurDateDos : LongInt;
Var
DT : DateTime;
Temp : Word;
Temp2 : LongInt;
Begin
GetDate (DT.Year, DT.Month, DT.Day, Temp);
GetTime (DT.Hour, DT.Min, DT.Sec, Temp);
PackTime (DT, Temp2);
Result := Temp2;
End;
Function CurDateJulian : LongInt;
Var
Date : DateTime;
Temp : Word;
Begin
GetDate (Date.Year, Date.Month, Date.Day, Temp);
Date.Hour := 0;
Date.Min := 0;
Date.Sec := 0;
DateG2J(Date.Year, Date.Month, Date.Day, Result);
End;
Function TimerSeconds : LongInt;
Var
Hour,
Minute,
Second,
Sec100 : Word;
Begin
GetTime (Hour, Minute, Second, Sec100);
Result := (Hour * 3600) + (Minute * 60) + Second;
End;
Function TimerMinutes : LongInt;
Var
Hour,
Min,
Sec,
Sec100 : Word;
Begin
GetTime (Hour, Min, Sec, Sec100);
Result := (Hour * 60) + Min;
End;
Function DateDos2Str (Date: LongInt; Format: Byte) : String;
{1 = MM/DD/YY 2 = DD/MM/YY 3 = YY/DD/MM}
Var
DT : DateTime;
M,
D,
Y : String[2];
Begin
UnPackTime (Date, DT);
M := strZero(DT.Month);
D := strZero(DT.Day);
Y := Copy(strI2S(DT.Year), 3, 2);
Case Format of
1 : Result := M + '/' + D + '/' + Y;
2 : Result := D + '/' + M + '/' + Y;
3 : Result := Y + '/' + M + '/' + D;
End;
End;
Function DateJulian2Str (Date: LongInt; Format: Byte) : String;
{1 = MM/DD/YY 2 = DD/MM/YY 3 = YY/DD/MM}
Var
M : String[2];
D : String[2];
Y : String[2];
Temp1 : Real;
Temp2 : Real;
Temp3 : Real;
Temp4 : Real;
Temp5 : Real;
Begin
Temp1 := Date + 68569.0;
Temp2 := Trunc(4 * Temp1 / 146097.0);
Temp1 := Temp1 - Trunc((146097.0 * Temp2 + 3) / 4);
Temp3 := Trunc(4000.0 * (Temp1 + 1) / 1461001.0);
Temp1 := Temp1 - Trunc(1461.0 * Temp3 / 4.0) + 31.0;
Temp4 := Trunc(80 * Temp1 / 2447.0);
Temp5 := Temp1 - Trunc(2447.0 * Temp4 / 80.0);
Temp1 := Trunc(Temp4 / 11);
Temp4 := Temp4 + 2 - 12 * Temp1;
Temp3 := 100 * (Temp2 - 49) + Temp3 + Temp1;
Y := Copy(strI2S(Trunc(Temp3)), 3, 2);
M := strZero(Trunc(Temp4));
D := strZero(Trunc(Temp5));
Case Format of
1 : Result := M + '/' + D + '/' + Y;
2 : Result := D + '/' + M + '/' + Y;
3 : Result := Y + '/' + M + '/' + D;
End;
End;
Function DateStr2Julian (Str: String) : LongInt; {MM/DD/YY to Julian Date}
Var
Month,
Day,
Year : Integer;
Temp : Real;
Temp2 : Real;
Begin
Month := strS2I(Copy(Str, 1, 2));
Day := strS2I(Copy(Str, 4, 2));
Year := strS2I(Copy(Str, 7, 2));
If Year < 20 Then
Inc(Year, 2000)
Else
Inc(Year, 1900);
Temp2 := (Month - 14) DIV 12;
Temp := Day - 32075 + Trunc(1461 * (Year + 4800 + Temp2) / 4);
Temp := Temp + Trunc(367 * (Month - 2 - Temp2 * 12) / 12);
Temp := Temp - Trunc(3 * Trunc((Year + 4900 + Temp2) / 100) / 4);
// Temp := Temp - (3 * (Year + 4900 + Temp2) DIV 100) DIV 4;
Result := Trunc(Temp);
End;
Function DateStr2Dos (Str: String) : LongInt; {MM/DD/YY to Dos Date}
Var
DT : DateTime;
Begin
DT.Year := strS2I(Copy(Str, 7, 2));
If Dt.Year < 80 Then
Inc(DT.Year, 2000)
Else
Inc(DT.Year, 1900);
DT.Month := strS2I(Copy(Str, 1, 2));
DT.Day := strS2I(Copy(Str, 4, 2));
DT.Hour := 0;
DT.Min := 0;
DT.Sec := 0;
PackTime (DT, Result);
End;
Function DateValid (Str: String) : Boolean;
Var
M,
D : Byte;
Begin
M := strS2I(Copy(Str, 1, 2));
D := strS2I(Copy(Str, 4, 2));
Result := (M > 0) and (M < 13) and (D > 0) and (D < 32);
End;
Function TimeDos2Str (Date: LongInt; Mode: Byte) : String;
Var
DT : DateTime;
Begin
UnPackTime (Date, DT);
Case Mode of
0 : Result := strZero(DT.Hour) + ':' + strZero(DT.Min);
1 : If DT.Hour > 11 Then Begin
If DT.Hour = 12 Then Inc(DT.Hour, 12);
Result := strZero(DT.Hour - 12) + ':' + strZero(DT.Min) + 'p'
End Else Begin
If DT.Hour = 0 Then Inc(DT.Hour, 12);
Result := strZero(DT.Hour) + ':' + strZero(DT.Min) + 'a';
End;
2 : Result := strZero(DT.Hour) + ':' + strZero(DT.Min) + ':' + strZero(DT.Sec);
End;
End;
Function DayOfWeek (Date: LongInt) : Byte;
Var
DT : DateTime;
Res : LongInt;
Begin
UnpackTime (Date, DT);
If DT.Month < 3 Then
Res := 365 * DT.Year + DT.Day + 31 * (DT.Month - 1) + Trunc ((DT.Year - 1) / 4) - Trunc(0.75 * Trunc((DT.Year - 1) / 100) + 1)
Else
Res := 365 * DT.Year + DT.Day + 31 * (DT.Month - 1) - Trunc (0.4 * DT.Month + 2.3) + Trunc (DT.Year / 4) - Trunc (0.75 * Trunc (DT.Year / 100) + 1);
Result := Res MOD 7;
End;
Function DaysAgo (Date: LongInt; dType: Byte) : LongInt;
Begin // 1 = date=julian, 2 = date=dosdate
Case dType of
1 : Result := CurDateJulian - Date;
2 : Result := CurDateJulian - DateStr2Julian(DateDos2Str(Date, 1));
End;
End;
Function TimerSet (Secs: LongInt) : LongInt;
Var
DT : DateTime;
Sec100 : Word;
Begin
GetTime (DT.Hour, DT.Min, DT.Sec, Sec100);
Result := ((DT.Min MOD 60) * 6000 + (DT.Sec MOD 60) * 100 + Sec100) + Secs;
End;
Function TimerUp (Secs: LongInt) : Boolean;
Var
DT : DateTime;
Sec100 : Word;
Temp : LongInt;
Begin
GetTime (DT.Hour, DT.Min, DT.Sec, Sec100);
Temp := (DT.Min MOD 60) * 6000 + (DT.Sec MOD 60) * 100 + Sec100;
If Temp < (Secs - 65536) Then
Temp := Temp + 360000;
Result := (Temp - Secs) >= 0;
End;
End.