home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / MKMSG104 / MKMISC.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-09  |  8KB  |  383 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. Procedure UpdateWordFlag(Var Flag: Word; Mask: Word; Setting: Boolean);
  22. {$IFDEF WINDOWS}
  23. Function  DTToUnixDate(DT: TDateTime): LongInt;
  24. Procedure UnixToDt(SecsPast: LongInt; Var DT: TDateTime);
  25. Function  GregorianToJulian(DT: TDateTime): LongInt;
  26. Function  ValidDate(DT: TDateTime): Boolean;
  27. {$ELSE}
  28. Function  DTToUnixDate(DT: DateTime): LongInt;
  29. Procedure UnixToDt(SecsPast: LongInt; Var DT: DateTime);
  30. Function  GregorianToJulian(DT: DateTime): LongInt;
  31. Function  ValidDate(DT: DateTime): Boolean;
  32. {$ENDIF}
  33. Function  ToUnixDate(FDate: LongInt): LongInt;
  34. Function  ToUnixDateStr(FDate: LongInt): String;
  35. Function  FromUnixDateStr(S: String): LongInt;
  36. Procedure JulianToGregorian(JulianDN : LongInt; Var Year, Month,
  37.   Day : Integer);
  38. Function  DaysAgo(DStr: String): LongInt;
  39.  
  40.  
  41. Implementation
  42.  
  43.  
  44. Uses
  45.   Crc32, MKString;
  46.  
  47.  
  48. Const
  49.    C1970 = 2440588;
  50.    D0 =    1461;
  51.    D1 =  146097;
  52.    D2 = 1721119;
  53.  
  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. Function ToUnixDate(FDate: LongInt): LongInt;
  292.   Var
  293.     {$IFDEF Windows}
  294.       DT: TDateTime;
  295.     {$ELSE}
  296.       DT: DateTime;
  297.     {$ENDIF}
  298.  
  299.   Begin
  300.   UnpackTime(Fdate, Dt);
  301.   ToUnixDate := DTToUnixDate(Dt);
  302.   End;
  303.  
  304.  
  305. Function ToUnixDateStr(FDate: LongInt): String;
  306.   Var
  307.   SecsPast: LongInt;
  308.   S: String;
  309.  
  310.   Begin
  311.   SecsPast := ToUnixDate(FDate);
  312.   S := '';
  313.   While (SecsPast <> 0) And (Length(s) < 255) DO
  314.     Begin
  315.     s := Chr((secspast And 7) + $30) + s;
  316.     secspast := (secspast Shr 3)
  317.     End;
  318.   s := '0' + s;
  319.   ToUnixDateStr := S;
  320.   End;
  321.  
  322.  
  323. Function FromUnixDateStr(S: String): LongInt;
  324.   Var
  325.     {$IFDEF WINDOWS}
  326.     DT: TDateTime;
  327.     {$ELSE}
  328.     DT: DateTime;
  329.     {$ENDIF}
  330.     secspast, datenum: LONGINT;
  331.     n: WORD;
  332.  
  333.   Begin
  334.   SecsPast := 0;
  335.   For n := 1 To Length(s) Do
  336.     SecsPast := (SecsPast shl 3) + Ord(s[n]) - $30;
  337.   Datenum := (SecsPast Div 86400) + c1970;
  338.   JulianToGregorian(DateNum, Integer(DT.Year), Integer(DT.Month),
  339.     Integer(DT.day));
  340.   SecsPast := SecsPast Mod 86400;
  341.   DT.Hour := SecsPast Div 3600;
  342.   SecsPast := SecsPast Mod 3600;
  343.   DT.Min := SecsPast Div 60;
  344.   DT.Sec := SecsPast Mod 60;
  345.   PackTime(DT, SecsPast);
  346.   FromUnixDateStr := SecsPast;
  347.   End;
  348.  
  349.  
  350. {$IFDEF WINDOWS}
  351. Function ValidDate(DT: TDateTime): Boolean;
  352. {$ELSE}
  353. Function ValidDate(DT: DateTime): Boolean;
  354. {$ENDIF}
  355.   Const
  356.     DOM: Array[1..12] of Byte = (31,29,31,30,31,30,31,31,30,31,30,31);
  357.  
  358.   Var
  359.     Valid: Boolean;
  360.  
  361.   Begin
  362.   Valid := True;
  363.   If ((DT.Month < 1) Or (DT.Month > 12)) Then
  364.     Valid := False;
  365.   If Valid Then
  366.     If ((DT.Day < 1) Or (DT.Day > DOM[DT.Month])) Then
  367.       Valid := False;
  368.   If ((Valid) And (DT.Month = 2) And (DT.Day = 29)) Then
  369.     If ((DT.Year Mod 4) <> 0) Then
  370.       Valid := False;
  371.   ValidDate := Valid;
  372.   End;
  373.  
  374. Procedure UpdateWordFlag(Var Flag: Word; Mask: Word; Setting: Boolean);
  375.   Begin
  376.   If Setting Then
  377.     Flag := Flag or Mask
  378.   Else
  379.     Flag := Flag and (Not Mask);
  380.   End;
  381.  
  382. End.
  383.