home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / MKMSG102.ZIP / MKMISC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-15  |  7.7 KB  |  378 lines
  1. Unit MKMisc;
  2.  
  3. {$I MKB.Def}
  4.  
  5. Interface
  6.  
  7. {$IFDEF WINDOWS}
  8. Uses WinDos;
  9. {$ELSE}
  10. Uses Dos;
  11. {$ENDIF}
  12.  
  13. Procedure SetLFlag(Var L: LongInt; Bit: Byte; Setting: Boolean);
  14. Function GetLFlag(L: LongInt; Bit: Byte): Boolean;
  15. Procedure SetWFlag(Var L: Word; Bit: Byte; Setting: Boolean);
  16. Function GetWFlag(L: Word; Bit: Byte): Boolean;
  17. Procedure SetBFlag(Var L: Byte; Bit: Byte; Setting: Boolean);
  18. Function GetBFlag(L: Byte; Bit: Byte): Boolean;
  19. Function StrCRC(Str: String): LongInt;
  20. Function NameCRC(Str: String): LongInt;
  21. {$IFDEF WINDOWS}
  22. Function DTToUnixDate(DT: TDateTime): LongInt;
  23. Procedure UnixToDt(SecsPast: LongInt; Var Dt: TDateTime);
  24. {$Else}
  25. Function DTToUnixDate(DT: DateTime): LongInt;
  26. Procedure UnixToDt(SecsPast: LongInt; Var DT: DateTime);
  27. {$EndIf}
  28. Function ToUnixDate(FDate: LongInt): LongInt;
  29. Function ToUnixDateStr(FDate: LongInt): String;
  30. Function FromUnixDateStr(S: String): LongInt;
  31. {$IFDEF WINDOWS}
  32. Function GregorianToJulian(DT: TDateTime): LongInt;
  33. Function ValidDate(DT: TDateTime): Boolean;
  34. {$ELSE}
  35. Function GregorianToJulian(DT: DateTime): LongInt;
  36. Function ValidDate(DT: DateTime): Boolean;
  37. {$ENDIF}
  38. Procedure JulianToGregorian(JulianDN : LongInt; Var Year, Month,
  39.   Day : Integer);
  40. Function DaysAgo(DStr: String): LongInt;
  41.  
  42.  
  43. Implementation
  44.  
  45.  
  46. Uses
  47.   Crc32, MKString;
  48.  
  49. Const
  50.    C1970 = 2440588;
  51.    D0 =    1461;
  52.    D1 =  146097;
  53.    D2 = 1721119;
  54.  
  55. Function DaysAgo(DStr: String): LongInt;
  56.   Var
  57.     {$IFDEF WINDOWS}
  58.     ODate: TDateTime;
  59.     CDate: TDateTime;
  60.     {$ELSE}
  61.     ODate: DateTime;
  62.     CDate: DateTime;
  63.     {$ENDIF}
  64.     Tmp: Word;
  65.  
  66.   Begin
  67.   GetDate(CDate.Year, CDate.Month, CDate.Day, Tmp);
  68.   CDate.Hour := 0;
  69.   CDate.Min := 0;
  70.   CDate.Sec := 0;
  71.   ODate.Year := Str2Long(Copy(DStr,7,2));
  72.   If ODate.Year < 80 Then
  73.     Inc(ODate.Year, 2000)
  74.   Else
  75.     Inc(ODate.Year, 1900);
  76.   ODate.Month := Str2Long(Copy(DStr,1,2));
  77.   ODate.Day := Str2Long(Copy(DStr, 4, 2));
  78.   ODate.Hour := 0;
  79.   ODate.Min := 0;
  80.   ODate.Sec := 0;
  81.   DaysAgo := GregorianToJulian(CDate) - GregorianToJulian(ODate);
  82.   End;
  83.  
  84.  
  85. Function NameCRC(Str: String): LongInt;
  86.   Var
  87.     L: LongInt;
  88.  
  89.   Begin
  90.   L := StrCrc(Str);
  91.   If ((L >= 0) and (L < 16)) Then
  92.     Inc(L,16);
  93.   NameCrc := L;
  94.   End;
  95.  
  96.  
  97. Function StrCRC(Str: String): LongInt;
  98.   Var
  99.     Crc: LongInt;
  100.     i: Word;
  101.  
  102.   Begin
  103.   i := 1;
  104.   Crc := $ffffffff;
  105.   While i <= Length(Str) Do
  106.     Begin
  107.     Crc := UpdC32(Ord(UpCase(Str[i])),Crc);
  108.     Inc(i);
  109.     End;
  110.   End;
  111.  
  112.  
  113. Procedure SetLFlag(Var L: LongInt; Bit: Byte; Setting: Boolean);
  114.   Var
  115.     Mask: LongInt;
  116.  
  117.   Begin
  118.   Mask := 1;
  119.   Mask := Mask Shl (Bit - 1);
  120.   If Setting Then
  121.     L := L or Mask
  122.   Else
  123.     L := (L and (Not Mask));
  124.   End;
  125.  
  126.  
  127. Function GetLFlag(L: LongInt; Bit: Byte): Boolean;
  128.   Var
  129.     Mask: LongInt;
  130.  
  131.   Begin
  132.   Mask := 1;
  133.   Mask := Mask Shl (Bit - 1);
  134.   If (L and Mask) = 0 Then
  135.     GetLFlag := False
  136.   Else
  137.     GetLFlag := True;
  138.   End;
  139.  
  140.  
  141. Procedure SetWFlag(Var L: Word; Bit: Byte; Setting: Boolean);
  142.   Var
  143.     Mask: Word;
  144.  
  145.   Begin
  146.   Mask := 1;
  147.   Mask := Mask Shl (Bit - 1);
  148.   If Setting Then
  149.     L := L or Mask
  150.   Else
  151.     L := (L and (Not Mask));
  152.   End;
  153.  
  154.  
  155. Function GetWFlag(L: Word; Bit: Byte): Boolean;
  156.   Var
  157.     Mask: Word;
  158.  
  159.   Begin
  160.   Mask := 1;
  161.   Mask := Mask Shl (Bit - 1);
  162.   If (L and Mask) = 0 Then
  163.     GetWFlag := False
  164.   Else
  165.     GetWFlag := True;
  166.   End;
  167.  
  168.  
  169. Procedure SetBFlag(Var L: Byte; Bit: Byte; Setting: Boolean);
  170.   Var
  171.     Mask: Byte;
  172.  
  173.   Begin
  174.   Mask := 1;
  175.   Mask := Mask Shl (Bit - 1);
  176.   If Setting Then
  177.     L := L or Mask
  178.   Else
  179.     L := (L and (Not Mask));
  180.   End;
  181.  
  182.  
  183. Function GetBFlag(L: Byte; Bit: Byte): Boolean;
  184.   Var
  185.     Mask: Byte;
  186.  
  187.   Begin
  188.   Mask := 1;
  189.   Mask := Mask Shl (Bit - 1);
  190.   If (L and Mask) = 0 Then
  191.     GetBFlag := False
  192.   Else
  193.     GetBFlag := True;
  194.   End;
  195.  
  196.  
  197. {$IFDEF WINDOWS}
  198. Function GregorianToJulian(DT: TDateTime): LongInt;
  199. {$ELSE}
  200. Function GregorianToJulian(DT: DateTime): LongInt;
  201. {$ENDIF}
  202. Var
  203.   Century: LongInt;
  204.   XYear: LongInt;
  205.   Temp: LongInt;
  206.   Month: LongInt;
  207.  
  208.   Begin
  209.   Month := DT.Month;
  210.   If Month <= 2 Then
  211.     Begin
  212.     Dec(DT.Year);
  213.     Inc(Month,12);
  214.     End;
  215.   Dec(Month,3);
  216.   Century := DT.Year Div 100;
  217.   XYear := DT.Year Mod 100;
  218.   Century := (Century * D1) shr 2;
  219.   XYear := (XYear * D0) shr 2;
  220.   GregorianToJulian :=  ((((Month * 153) + 2) div 5) + DT.Day) + D2
  221.     + XYear + Century;
  222.   End;
  223.  
  224.  
  225. Procedure JulianToGregorian(JulianDN : LongInt; Var Year, Month,
  226.   Day : Integer);
  227.  
  228.   Var
  229.     Temp,
  230.     XYear: LongInt;
  231.     YYear,
  232.     YMonth,
  233.     YDay: Integer;
  234.  
  235.   Begin
  236.   Temp := (((JulianDN - D2) shl 2) - 1);
  237.   XYear := (Temp Mod D1) or 3;
  238.   JulianDN := Temp Div D1;
  239.   YYear := (XYear Div D0);
  240.   Temp := ((((XYear mod D0) + 4) shr 2) * 5) - 3;
  241.   YMonth := Temp Div 153;
  242.   If YMonth >= 10 Then
  243.     Begin
  244.     YYear := YYear + 1;
  245.     YMonth := YMonth - 12;
  246.     End;
  247.   YMonth := YMonth + 3;
  248.   YDay := Temp Mod 153;
  249.   YDay := (YDay + 5) Div 5;
  250.   Year := YYear + (JulianDN * 100);
  251.   Month := YMonth;
  252.   Day := YDay;
  253.   End;
  254.  
  255.  
  256. {$IFDEF WINDOWS}
  257. Procedure UnixToDt(SecsPast: LongInt; Var Dt: TDateTime);
  258. {$ELSE}
  259. Procedure UnixToDt(SecsPast: LongInt; Var Dt: DateTime);
  260. {$ENDIF}
  261.   Var
  262.     DateNum: LongInt;
  263.  
  264.   Begin
  265.   Datenum := (SecsPast Div 86400) + c1970;
  266.   JulianToGregorian(DateNum, Integer(DT.Year), Integer(DT.Month),
  267.     Integer(DT.day));
  268.   SecsPast := SecsPast Mod 86400;
  269.   DT.Hour := SecsPast Div 3600;
  270.   SecsPast := SecsPast Mod 3600;
  271.   DT.Min := SecsPast Div 60;
  272.   DT.Sec := SecsPast Mod 60;
  273.   End;
  274.  
  275.  
  276. {$IFDEF WINDOWS}
  277. Function DTToUnixDate(DT: TDateTime): LongInt;
  278. {$Else}
  279. Function DTToUnixDate(DT: DateTime): LongInt;
  280. {$EndIf}
  281.    Var
  282.      SecsPast, DaysPast: LongInt;
  283.  
  284.   Begin
  285.   DaysPast := GregorianToJulian(DT) - c1970;
  286.   SecsPast := DaysPast * 86400;
  287.   SecsPast := SecsPast + (LongInt(DT.Hour) * 3600) + (DT.Min * 60) + (DT.Sec);
  288.   DTToUnixDate := SecsPast;
  289.   End;
  290.  
  291.  
  292. Function ToUnixDate(FDate: LongInt): LongInt;
  293.   Var
  294.     {$IFDEF WINDOWS}
  295.       DT: TDateTime;
  296.     {$ELSE}
  297.       DT: DateTime;
  298.     {$ENDIF}
  299.  
  300.   Begin
  301.   UnpackTime(Fdate, Dt);
  302.   ToUnixDate := DTToUnixDate(Dt);
  303.   End;
  304.  
  305.  
  306. Function ToUnixDateStr(FDate: LongInt): String;
  307.   Var
  308.   SecsPast: LongInt;
  309.   S: String;
  310.  
  311.   Begin
  312.   SecsPast := ToUnixDate(FDate);
  313.   S := '';
  314.   While (SecsPast <> 0) And (Length(s) < 255) DO
  315.     Begin
  316.     s := Chr((secspast And 7) + $30) + s;
  317.     secspast := (secspast Shr 3)
  318.     End;
  319.   s := '0' + s;
  320.   ToUnixDateStr := S;
  321.   End;
  322.  
  323.  
  324. Function FromUnixDateStr(S: String): LongInt;
  325.   Var
  326.     {$IFDEF WINDOWS}
  327.     DT: TDateTime;
  328.     {$ELSE}
  329.     DT: DateTime;
  330.     {$ENDIF}
  331.     secspast, datenum: LONGINT;
  332.     n: WORD;
  333.  
  334.   Begin
  335.   SecsPast := 0;
  336.   For n := 1 To Length(s) Do
  337.     SecsPast := (SecsPast shl 3) + Ord(s[n]) - $30;
  338.   Datenum := (SecsPast Div 86400) + c1970;
  339.   JulianToGregorian(DateNum, Integer(DT.Year), Integer(DT.Month),
  340.     Integer(DT.day));
  341.   SecsPast := SecsPast Mod 86400;
  342.   DT.Hour := SecsPast Div 3600;
  343.   SecsPast := SecsPast Mod 3600;
  344.   DT.Min := SecsPast Div 60;
  345.   DT.Sec := SecsPast Mod 60;
  346.   PackTime(DT, SecsPast);
  347.   FromUnixDateStr := SecsPast;
  348.   End;
  349.  
  350.  
  351. {$IFDEF WINDOWS}
  352. Function ValidDate(DT: TDateTime): Boolean;
  353. {$ELSE}
  354. Function ValidDate(DT: DateTime): Boolean;
  355. {$ENDIF}
  356.  
  357.   Const
  358.     DOM: Array[1..12] of Byte = (31,29,31,30,31,30,31,31,30,31,30,31);
  359.  
  360.   Var
  361.     Valid: Boolean;
  362.  
  363.   Begin
  364.   Valid := True;
  365.   If ((DT.Month < 1) Or (DT.Month > 12)) Then
  366.     Valid := False;
  367.   If Valid Then
  368.     If ((DT.Day < 1) Or (DT.Day > DOM[DT.Month])) Then
  369.       Valid := False;
  370.   If ((Valid) And (DT.Month = 2) And (DT.Day = 29)) Then
  371.     If ((DT.Year Mod 4) <> 0) Then
  372.       Valid := False;
  373.   ValidDate := Valid;
  374.   End;
  375.  
  376.  
  377. End.
  378.