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