1 Unit GeneralP;
2 {Version 1.2}
3 interface
4 uses
5 {$IfNDef __GPC__}
6   DOS,
7 {$EndIf}
8 {$IfDef SPEED}
9   BseDOS, BseDev,
10 {$EndIf}
11 {$IfDef VIRTUALPASCAL}
12  {Use32,} OS2Base, OS2Def,
13 {$EndIf}
14 {$IfDef UNIX}
15  {$ifdef FPC}
16   linux,
17  {$endif}
18 {$EndIf}
19 {$ifndef __GPC__}
20   strings,
21 {$endif}
22   Types;
23 
24 Const
25 {$IfDef UNIX}
26   DirSep = '/';
27 {$Else}
28   DirSep = '\';
29 {$EndIf}
30 
31 {$IfDef __GPC__}
32   pi = 3.14159265358979323846;
33   MaxLongInt = MaxInt;
34 {$EndIf}
35 
36   Leer='                                                                                      ';
37   C1970 = 2440588;
38   D0 =    1461;
39   D1 =  146097;
40   D2 = 1721119;
41   Digits = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
42   WkDaysEng  : Array[0..6] of String[9] = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday');
43   WkDaysGer  : Array[0..6] of String[10] = ('Sonntag', 'Montag', 'Dienstag', 'Mittwoch', 'Donnerstag', 'Freitag', 'Samstag');
44   WkDays3Eng : Array[0..6] of String[3] = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
45   WkDays2Eng : Array[0..6] of String[2] = ('Su', 'Mo', 'Tu', 'We', 'Th', 'Fr', 'Sa');
46   WkDays3Ger : Array[0..6] of String[3] = ('Son', 'Mon', 'Die', 'Mit', 'Don', 'Fre', 'Sam');
47   WkDays2Ger : Array[0..6] of String[2] = ('So', 'Mo', 'Di', 'Mi', 'Do', 'Fr', 'Sa');
48   MonthsEng  : Array[1..12] of String[9] = ('January', 'February', 'March', 'April', 'May', 'June',
49                                             'July', 'August', 'September', 'October', 'November', 'December');
50   MonthsGer  : Array[1..12] of String[9] = ('Januar', 'Februar', 'M�rz', 'April', 'Mai', 'Juni',
51                                             'Juli', 'August', 'September', 'Oktober', 'November', 'Dezember');
52   Months3Eng : Array[1..12] of String[3] = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
53                                             'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
54   Months3Ger : Array[1..12] of String[3] = ('Jan', 'Feb', 'M�r', 'Apr', 'Mai', 'Jun',
55                                             'Jul', 'Aug', 'Sep', 'Okt', 'Nov', 'Dez');
56 
57       CRC16Tab : ARRAY[0..255] OF WORD = (
58       $0000, $1021, $2042, $3063, $4084, $50a5, $60c6, $70e7,
59       $8108, $9129, $a14a, $b16b, $c18c, $d1ad, $e1ce, $f1ef,
60       $1231, $0210, $3273, $2252, $52b5, $4294, $72f7, $62d6,
61       $9339, $8318, $b37b, $a35a, $d3bd, $c39c, $f3ff, $e3de,
62       $2462, $3443, $0420, $1401, $64e6, $74c7, $44a4, $5485,
63       $a56a, $b54b, $8528, $9509, $e5ee, $f5cf, $c5ac, $d58d,
64       $3653, $2672, $1611, $0630, $76d7, $66f6, $5695, $46b4,
65       $b75b, $a77a, $9719, $8738, $f7df, $e7fe, $d79d, $c7bc,
66       $48c4, $58e5, $6886, $78a7, $0840, $1861, $2802, $3823,
67       $c9cc, $d9ed, $e98e, $f9af, $8948, $9969, $a90a, $b92b,
68       $5af5, $4ad4, $7ab7, $6a96, $1a71, $0a50, $3a33, $2a12,
69       $dbfd, $cbdc, $fbbf, $eb9e, $9b79, $8b58, $bb3b, $ab1a,
70       $6ca6, $7c87, $4ce4, $5cc5, $2c22, $3c03, $0c60, $1c41,
71       $edae, $fd8f, $cdec, $ddcd, $ad2a, $bd0b, $8d68, $9d49,
72       $7e97, $6eb6, $5ed5, $4ef4, $3e13, $2e32, $1e51, $0e70,
73       $ff9f, $efbe, $dfdd, $cffc, $bf1b, $af3a, $9f59, $8f78,
74       $9188, $81a9, $b1ca, $a1eb, $d10c, $c12d, $f14e, $e16f,
75       $1080, $00a1, $30c2, $20e3, $5004, $4025, $7046, $6067,
76       $83b9, $9398, $a3fb, $b3da, $c33d, $d31c, $e37f, $f35e,
77       $02b1, $1290, $22f3, $32d2, $4235, $5214, $6277, $7256,
78       $b5ea, $a5cb, $95a8, $8589, $f56e, $e54f, $d52c, $c50d,
79       $34e2, $24c3, $14a0, $0481, $7466, $6447, $5424, $4405,
80       $a7db, $b7fa, $8799, $97b8, $e75f, $f77e, $c71d, $d73c,
81       $26d3, $36f2, $0691, $16b0, $6657, $7676, $4615, $5634,
82       $d94c, $c96d, $f90e, $e92f, $99c8, $89e9, $b98a, $a9ab,
83       $5844, $4865, $7806, $6827, $18c0, $08e1, $3882, $28a3,
84       $cb7d, $db5c, $eb3f, $fb1e, $8bf9, $9bd8, $abbb, $bb9a,
85       $4a75, $5a54, $6a37, $7a16, $0af1, $1ad0, $2ab3, $3a92,
86       $fd2e, $ed0f, $dd6c, $cd4d, $bdaa, $ad8b, $9de8, $8dc9,
87       $7c26, $6c07, $5c64, $4c45, $3ca2, $2c83, $1ce0, $0cc1,
88       $ef1f, $ff3e, $cf5d, $df7c, $af9b, $bfba, $8fd9, $9ff8,
89       $6e17, $7e36, $4e55, $5e74, $2e93, $3eb2, $0ed1, $1ef0);
90 
91 Var
92  FilePerm: Word; {Permission used for created files under UNIX}
93  DirPerm: Word; {Permission used for created directories under UNIX}
94  ChangePerm: Boolean; {change permissions when copying or moving files?}
95 
96 
97 {$IfDef __GPC__}
98 Procedure Assign ( Var T: Text; Name: String255 );
99 Procedure FillChar ( Var Dest: Void; Count: Integer; C: Char );
ParamCountnull100 Function ParamCount: Integer;  (* This is stupid. *)
ParamStrnull101 Function ParamStr ( i: Integer ): String255;
GetEnvnull102 Function GetEnv ( Entry: String255 ): String255;
UpCasenull103 Function UpCase ( Ch: Char ): Char;
StrPasnull104 function StrPas(Src: CString): String255;
StrPCopynull105 function StrPCopy(Dest: CString; Src: String): CString;
Execnull106 Function Exec(prog, params: String255): Integer;
107 {$EndIf __GPC__}
108 
109 Procedure Delay(secs: Word);
110 
111 {$IfNDef SPEED}
112 Procedure GetFTime2(var f; var Year, Month, Day, Hour, Min, Sec: Word);
113 {$EndIf}
114 
LowCasenull115 Function LowCase(Ch:Char) : Char;
UpStrnull116 Function UpStr(_Str: String255) : String255;
LowStrnull117 Function LowStr(_Str: String255) : String255;
Date2Strnull118 Function Date2Str(Date: TimeTyp) : String10;
Time2Strnull119 Function Time2Str(Time: TimeTyp) : String10;
Str2Datenull120 Function Str2Date(_Str:String255; var Date:TimeTyp):boolean;
Str2Timenull121 Function Str2Time(_Str:String255; var Time:TimeTyp):boolean;
122 Procedure Today(var Date : TimeTyp);
123 Procedure Now(var Time : TimeTyp);
statusbarnull124 FUNCTION statusbar(total,aktuell:LONGINT; Laenge:BYTE):STRING255;
WordToHexnull125 Function WordToHex(w: Word):String4;
126 Procedure FileList(Start: String255; FileSpec : Byte);
LowerOfnull127 Function LowerOf(a, b : LongInt) : LongInt;
TimeDiffnull128 Function TimeDiff(Time1, Time2 : TimeTyp): LongInt; {in Sekunden}
KillLeadingSpcsnull129 Function KillLeadingSpcs(s: String255): String255;
KillTrailingSpcsnull130 Function KillTrailingSpcs(s: String255): String255;
KillSpcsnull131 Function KillSpcs(s: String): String;
AddDirSepnull132 Function AddDirSep(s: String255): String255;
GregorianToJuliannull133 Function GregorianToJulian(DT: TimeTyp): ULong;
134 Procedure JulianToGregorian(JulianDN : ULong; Var Year, Month, Day : Word);
135 Procedure UNIXToDt(SecsPast: ULong; Var Dt: TimeTyp);
DTToUNIXDatenull136 Function DTToUNIXDate(DT: TimeTyp): ULong;
DTToUNIXStrnull137 Function DTToUNIXStr(DT: TimeTyp): String20;
DTToUNIXHexStrnull138 Function DTToUNIXHexStr(DT: TimeTyp): String8;
ToUNIXDatenull139 Function ToUNIXDate(FDate: LongInt): ULong;
IntToStrnull140 Function IntToStr(x: LongInt):String255;
IntToStr0null141 Function IntToStr0(x: LongInt):String255;
IntToStr03null142 Function IntToStr03(x: Word):String3;
StrToIntnull143 Function StrToInt(s: String255): LongInt;
OctalStrToIntnull144 Function OctalStrToInt(s: String255): LongInt;
FileExistnull145 Function FileExist(fn: String255):Boolean;
DirExistnull146 Function DirExist(fn: String255):Boolean;
LastPosnull147 Function LastPos(SubStr, S: String255): Byte;
MakeDirnull148 Function MakeDir(Dir: String128): Boolean;
RepEnvnull149 Function RepEnv(s: String255):String255;
Translatenull150 Function Translate(s: String255; IChar, OChar: Char): String255;
DosAppendnull151 Function DosAppend(var f: File): Integer;
MoveFilenull152 Function MoveFile(OName, NName: String255): Boolean;
RepFilenull153 Function RepFile(OName, NName: String255): Boolean;
CopyFilenull154 Function CopyFile(OName, NName: String255): Boolean;
DelFilenull155 Function DelFile(Name: String255): Boolean;
TruncFilenull156 Function TruncFile(Name: String255): Boolean;
CreateSemnull157 Function CreateSem(Name: String255): Boolean;
158 Procedure GetFileTime(Name: String255; var Year, Month, Day, Hour, Min, Sec: Word);
GetFSizenull159 Function GetFSize(Name: String255): LongInt;
leapyearnull160 Function leapyear (c, y : Byte) : Boolean;
DaysInMonthnull161 Function DaysInMonth (DT:TimeTyp; m : Byte) : Byte;
DayOfYearnull162 Function DayOfYear (DT: TimeTyp) : Word;
CRC16null163 function CRC16(s:string255):word;
GetCRC16null164 Function GetCRC16(fn: String255): Word;
165 
166 implementation
167 
168 Const fCarry = $0001;
169 
170 
171 {$IfDef __GPC__}
172 
173 Procedure Assign ( Var T: Text; Name: String255 );
174 Var
175   B: BindingType;
176 
177 begin
178   unbind ( T );
179   B:= binding ( T );
180   B.Name:= Name + chr ( 0 );
181   bind ( T, B );
182   B:= binding ( T );
183 end;
184 
185 Procedure FillChar ( Var Dest: Void; Count: Integer; C: Char );
186 
187 Type
188   BytePtr = ^Byte;
189 
190 Var
191   p, q: BytePtr;
192 
193 begin
194   {$W-}  (* Warning "dereferencing `void *' pointer" is a minor bug in GPC *)
195   p:= @Dest;
196   {$W+}
197   q:= BytePtr ( LongInt ( p ) + Count );
198   while LongInt ( p ) < LongInt ( q ) do
199     begin
200       p^:= ord ( C );
201       LongInt ( p ) := LongInt(p) + 1;
202     end
203 end;
204 
rtsParamCountnull205 Function rtsParamCount: Integer;
206 AsmName '_p_paramcount';
207 
rtsParamStrnull208 Function rtsParamStr ( i: Integer; Var S: String255 ): Boolean;
209 AsmName '_p_paramstr';
210 
211 
ParamCountnull212 Function ParamCount: Integer;
213 begin
214   ParamCount:= rtsParamCount - 1;
215 end;
216 
217 
ParamStrnull218 Function ParamStr ( i: Integer ): String255;
219 Var
220   S: String255;
221 begin
222   if rtsParamStr ( i, S ) then
223     ParamStr:= Trim ( S )
224   else
225     ParamStr:= '';
226 end;
227 
228 
CGetEnvnull229 Function CGetEnv ( Entry: __CString__ ): PChar;
230 AsmName 'getenv';
231 
232 
GetEnvnull233 Function GetEnv ( Entry: String255 ): String255;
234 Var
235   C: PChar;
236   Contents: String255;
237 
238 begin
239   C:= CGetEnv ( Entry );
240   Contents:= '';
241   if C <> Nil then
242     while ( C^ <> chr ( 0 ) )
243      and ( length ( Contents ) < Contents.Capacity ) do
244       begin
245         Contents:= Contents + C^;
246         LongInt ( C ) := LongInt(C)+1;
247       end;
248   GetEnv:= Contents;
249 end;
250 
UpCasenull251 Function UpCase ( Ch: Char ): Char;
252 begin
253   if ( Ch >= 'a' ) and ( Ch <= 'z' ) then
254     dec ( Ch, ord ( 'a' ) - ord ( 'A' ) );
255   UpCase:= Ch;
256 end;
257 
258 { Convert a "C" string to a "Pascal" string }
StrPasnull259 function StrPas(Src: CString): String255;
260 var
261  S : String255;
262 
263  begin
264  S := '';
265  if (Src <> NIL) then while ( (Src^ <> chr(0)) AND (length(S) < S.capacity)) do
266   begin
267   S := S + Src^;
268   Word(Src) := Word(Src)+1;
269   end;
270  StrPas := S;
271  end;
272 
273 { Convert a "Pascal" string to a "C" string }
StrPCopynull274 function StrPCopy(Dest: CString; Src: String): CString;
275 var
276  c: integer;
277  p: CString;
278 
279  begin
280  p := Dest;
281  for c:=1 to length(Src) do
282   begin
283   p^ := Src[c];
284   word(p) := word(p)+1;
285   end;
286  p^ := chr(0);
287  StrPCopy := Dest;
288  end;
289 
systemnull290 function system(name : CString): integer; C;
291 
Execnull292 Function Exec(prog, params: String255): Integer;
293 var
294  pName: CString;
295 
296  begin
297  getmem(pName, 256);
298  pName := StrPCopy(pName, prog+params);
299  Exec := system(pName);
300  freemem(pName, 256);
301  end;
302 
_itoanull303 Function _itoa (value: integer; s: cstring; radix: integer): CString; C;
_ltoanull304 Function _ltoa (value: LongInt; s: cstring; radix: integer): CString; C;
_ultoanull305 Function _ultoa (value: ULong; s: cstring; radix: integer): CString; C;
306 
307 {$ENDIF __GPC__}
308 
309 
310 Procedure Delay(secs: Word);
311 Var
312  i: Word;
313 
314  Begin
315  {bogus delay}
316  For i := 1 to 10000 do Write;
317  End;
318 
319 
LowCasenull320 Function LowCase(Ch:Char):Char;
321  Begin
322  if (Ch >= 'A') and (Ch <= 'Z') then LowCase := Char(Byte(Ch) + 32)
323  Else LowCase := Ch;
324  End;
325 
UpStrnull326 Function UpStr(_Str:String255) : String255;
327 Var
328  s:String255;
329  i:Byte;
330 
331  Begin
332  s := _str;
333  For i:= 1 to Length(_str) do s[i]:=UpCase(_str[i]);
334  UpStr:= s;
335  End;
336 
LowStrnull337 Function LowStr(_Str:String255) : String255;
338 Var
339  s:String255;
340  i:Byte;
341 
342  Begin
343  s[0] := _str[0];
344  For i:= 1 to Length(_str) do s[i]:= LowCase(_str[i]);
345  LowStr:= s;
346  End;
347 
Date2Strnull348 Function Date2Str(Date:TimeTyp) : String10;
349 var
350  s,s2:String[10];
351  i: Byte;
352 
353 begin
354 s2 := IntToStr(Date.Day);
355 If (length(s2) < 2) then s2 := '0'+s2
356 Else If (s2[1] = ' ') then s2[1] := '0';
357 s:=s2+'.';
358 s2 := IntToStr(Date.Month);
359 If (length(s2) < 2) then s2 := '0'+s2
360 Else If (s2[1] = ' ') then s2[1] := '0';
361 s:=s+s2+'.';
362 s2 := IntToStr(Date.Year);
363 If (length(s2) < 4) then
364  Begin
365  for i := 1 to (4 - length(s2)) do s2 := '0' + s2;
366  If (s2[4] = ' ') then s2[4] := '0';
367  End
368 Else
369  Begin
370  If (s2[1] = ' ') then s2[1] := '0';
371  If (s2[2] = ' ') then s2[2] := '0';
372  If (s2[3] = ' ') then s2[3] := '0';
373  If (s2[4] = ' ') then s2[4] := '0';
374  End;
375 Date2Str:=s+s2;
376 end;
377 
Time2Strnull378 Function Time2Str(Time:TimeTyp) : String10;
379 var s,s2:String[10];
380 begin
381 s2 := IntToStr(Time.Hour);
382 If (length(s2) < 2) then s2 := '0'+s2
383 Else If (s2[1] = ' ') then s2[1] := '0';
384 s:=s2+':';
385 s2 := IntToStr(Time.Min);
386 If (length(s2) < 2) then s2 := '0'+s2
387 Else If (s2[1] = ' ') then s2[1] := '0';
388 s:=s+s2+':';
389 s2 := IntToStr(Time.Sec);
390 If (length(s2) < 2) then s2 := '0'+s2
391 Else If (s2[1] = ' ') then s2[1] := '0';
392 Time2Str:=s+s2;
393 end;
394 
Str2Datenull395 Function Str2Date(_Str:String255; var Date:TimeTyp):boolean;
396 var
397  OK:boolean;
398 {$IfDef VIRTUALPASCAL}
399   Error:LongInt;
400 {$Else}
401   Error:integer;
402 {$EndIf}
403 
404 begin
405 OK:=Pos('.', _Str)=3;
406 If OK then begin
407    Val(Copy(_Str, 1, 2), Date.Day, Error);
408    Delete(_Str, 1, 3);
409    OK:=(Pos('.', _Str)=3) and (Error=0);
410    If OK then begin
411       Val(Copy(_Str, 1, 2), Date.Month, Error);
412       Delete(_Str, 1, 3);
413       OK:=(Error=0);
414       If OK then Val(Copy(_Str, 1, 4), Date.Year, Error);
415       OK:=(Error=0);
416       end;
417    end;
418 Str2Date:=OK;
419 end;
420 
Str2Timenull421 Function Str2Time(_Str:String255; var Time:TimeTyp):boolean;
422 var
423  OK:boolean;
424 {$IfDef VIRTUALPASCAL}
425   Error:LongInt;
426 {$Else}
427   Error:integer;
428 {$EndIf}
429 
430 begin
431 OK:=(Pos(':', _Str)=3);
432 If OK then begin
433    Val(Copy(_Str, 1, 2), Time.Hour, Error);
434    Delete(_Str, 1, 3);
435    OK:=(Pos(':', _Str)=3) and (Error=0);
436    If OK then begin
437       Val(Copy(_Str, 1, 2), Time.Min, Error);
438       Delete(_Str, 1, 3);
439       OK:=(Error=0);
440       end;
441       If OK then begin
442          Val(Copy(_Str, 1, 2), Time.Sec, Error);
443          OK:=(Error=0);
444          end;
445    end;
446 Str2Time:=OK;
447 end;
448 
449 {$IfDef VIRTUALPASCAL}
450 Procedure Today(var Date : TimeTyp);
451 Var
452  Y, M, D, DOW: LongInt;
453 begin
454 GetDate(Y, M, D, DOW);
455 With Date do
456  Begin
457  Year := Y;
458  Month := M;
459  Day := D;
460  DayOfWeek := DOW;
461  End;
462 end;
463 {$Else}
464 Procedure Today(var Date : TimeTyp);
465 begin
466 {$ifdef __GPC__}
467 With Date do GetDate(Year, Month, Day, DayOfWeek);
468 {$else}
469 With Date do DOS.GetDate(Year, Month, Day, DayOfWeek);
470 {$endif}
471 end;
472 {$EndIf}
473 
474 {$IfDef VIRTUALPASCAL}
475 Procedure Now(var Time : TimeTyp);
476 Var
477  H, M, S, S100: LongInt;
478 
479 begin
480 GetTime(H, M, S, S100);
481 With Time do
482  Begin
483  Hour := H;
484  Min := M;
485  Sec := S;
486  Sec100 := S100;
487  End;
488 end;
489 {$Else}
490 Procedure Now(var Time : TimeTyp);
491 begin
492 {$ifdef __GPC__}
493 With Time do GetTime(Hour, Min, Sec, Sec100);
494 {$else}
495 With Time do DOS.GetTime(Hour, Min, Sec, Sec100);
496 {$endif}
497 end;
498 {$EndIf}
499 
statusbarnull500 FUNCTION statusbar(total,aktuell:LONGINT; Laenge:BYTE):STRING255;
501 {*               kleine Fortschrittsanzeige                 *}
502 var i:LONGINT;
503     s:STRING255;
504     a:BYTE;
505 BEGIN
506   s[0]:=CHR(Laenge); a:=Round(aktuell/total*laenge);
507   FOR i:=1 to a DO s[i]:=#178; FOR i:=a+1 to laenge DO s[i]:=#176;
508   statusbar:=s;
509 END;
510 
WordToHexnull511 Function WordToHex(w: Word):String4;
512 const
513   hexChars: array [0..$F] of Char =
514     '0123456789abcdef';
515 begin
516 WordToHex:=hexChars[Hi(w) shr 4]+hexChars[Hi(w) and $F]+
517            hexChars[Lo(w) shr 4]+hexChars[Lo(w) and $F];
518 end;
519 
520 Procedure FileList(Start: String255; FileSpec : Byte);
521 Var
522   SRec: SearchRec;
523 Begin
524   WriteLn(Start);
525   FindFirst(Start + DirSep + '*.*', FileSpec, SRec);
526   While (DOS.DosError = 0) Do Begin
527     If ((SRec.Attr And FileSpec) > 0)
528        And not ((SRec.Name = '.') or (SRec.Name = '..')) Then FileList(Start + DirSep + SRec.Name, FileSpec);
529     FindNext(SRec);
530     End;
531 End;
532 
LowerOfnull533 Function LowerOf(a, b : LongInt): LongInt;
534 begin
535 If a < b then LowerOf := a Else LowerOf := b;
536 end;
537 
TimeDiffnull538 Function TimeDiff(Time1, Time2 : TimeTyp): LongInt; {in Sekunden}
539 var TDiff : LongInt;
540 begin
541 TDiff:=LongInt(LongInt(Time1.Hour) - LongInt(Time2.Hour)) * 3600;
542 TDiff:=TDiff + LongInt(LongInt(Time1.Min) - LongInt(Time2.Min)) * 60;
543 TDiff:=TDiff + LongInt(LongInt(Time1.Sec) - LongInt(Time2.Sec));
544 TimeDiff:= Abs(TDiff);
545 end;
546 
KillLeadingSpcsnull547 Function KillLeadingSpcs(s: String255):String255;
548   Begin
549   While (s[1] = ' ') and (Length(s) > 0) do Delete(s, 1, 1);
550   KillLeadingSpcs := s;
551   End;
552 
KillTrailingSpcsnull553 Function KillTrailingSpcs(s: String255):String255;
554   Begin
555   While (s[Length(s)] = ' ') and (Length(s) > 0) do Delete(s, Length(s), 1);
556   KillTrailingSpcs := s;
557   End;
558 
KillSpcsnull559 Function KillSpcs(s: String): String; {kill leading and trailing spaces}
560  Begin
561  While (s[1] in [' ', #9]) and (Length(s) > 0) do Delete(s, 1, 1);
562  While (s[Length(s)] in [' ', #9]) and (Length(s) > 0) do Delete(s, Length(s), 1);
563  KillSpcs := s;
564  End;
565 
AddDirSepnull566 Function AddDirSep(s: String255): String255;
567  Begin
568  If (s[Byte(s[0])] <> DirSep) then AddDirSep := s + DirSep
569  Else AddDirSep := s;
570  End;
571 
GregorianToJuliannull572 Function GregorianToJulian(DT: TimeTyp): ULong;
573 Var
574   Century: ULong;
575   XYear: ULong;
576   Temp: ULong;
577   Month: ULong;
578 
579   Begin
580   Month := DT.Month;
581   If Month <= 2 Then
582     Begin
583     Dec(DT.Year);
584     Month := Month + 12;
585     End;
586   Dec(Month,3);
587   Century := DT.Year Div 100;
588   XYear := DT.Year Mod 100;
589   Century := (Century * D1) shr 2;
590   XYear := (XYear * D0) shr 2;
591   GregorianToJulian :=  ((((Month * 153) + 2) div 5) + DT.Day) + D2
592     + XYear + Century;
593   End;
594 
595 Procedure JulianToGregorian(JulianDN : ULong; Var Year, Month,
596   Day : Word);
597 
598   Var
599     Temp,
600     XYear: ULong;
601     YYear,
602     YMonth,
603     YDay: Integer;
604 
605   Begin
606   Temp := (((JulianDN - D2) shl 2) - 1);
607   XYear := (Temp Mod D1) or 3;
608   JulianDN := Temp Div D1;
609   YYear := (XYear Div D0);
610   Temp := ((((XYear mod D0) + 4) shr 2) * 5) - 3;
611   YMonth := Temp Div 153;
612   If YMonth >= 10 Then
613     Begin
614     YYear := YYear + 1;
615     YMonth := YMonth - 12;
616     End;
617   YMonth := YMonth + 3;
618   YDay := Temp Mod 153;
619   YDay := (YDay + 5) Div 5;
620   Year := YYear + (JulianDN * 100);
621   Month := YMonth;
622   Day := YDay;
623   End;
624 
625 Procedure UNIXToDt(SecsPast: ULong; Var Dt: TimeTyp);
626   Var
627     DateNum: ULong;
628 
629   Begin
630   Datenum := (SecsPast Div 86400) + c1970;
631   JulianToGregorian(DateNum, DT.Year, DT.Month, DT.day);
632   SecsPast := SecsPast Mod 86400;
633   DT.Hour := SecsPast Div 3600;
634   SecsPast := SecsPast Mod 3600;
635   DT.Min := SecsPast Div 60;
636   DT.Sec := SecsPast Mod 60;
637   End;
638 
DTToUNIXDatenull639 Function DTToUNIXDate(DT: TimeTyp): ULong;
640    Var
641      SecsPast, DaysPast: ULong;
642 
643   Begin
644   DaysPast := GregorianToJulian(DT) - c1970;
645   SecsPast := DT.Sec + ULong(DT.Min)*60 + ULong(DT.Hour)*3600 + DaysPast*86400;
646   DTToUNIXDate := SecsPast;
647   End;
648 
ToUNIXDatenull649 Function ToUNIXDate(FDate: LongInt): ULong;
650   Var
651 {$IfDef VIRTUALPASCAL}
652       DT: DOS.DateTime;
653 {$Else}
654       DT: DateTime;
655 {$EndIf}
656       DT2: TimeTyp;
657 
658   Begin
659   UnpackTime(Fdate, Dt);
660   dt2.Day := dt.day;
661   dt2.Month := dt.Month;
662   dt2.Year := dt.Year;
663   dt2.Hour := dt.Hour;
664   dt2.Min := dt.Min;
665   dt2.Sec := dt.Sec;
666   dt2.Sec100 := 0;
667   ToUNIXDate := DTToUnixDate(Dt2);
668   End;
669 
DTToUNIXStrnull670 Function DTToUNIXStr(DT: TimeTyp): String20;
671 Var
672   s : String[20];
673 
674   Begin
675   Str(DTToUNIXDate(DT), s);
676   DTToUNIXStr := s;
677   End;
678 
DTToUNIXHexStrnull679 Function DTToUNIXHexStr(DT: TimeTyp): String8;
680 Var
681   s : String[20];
682   i: ULong;
683 
684   Begin
685   i := DTToUNIXDate(DT);
686   s := WordToHex(word(i SHR 16)) + WordToHex(word(i));
687   DTToUNIXHexStr := s;
688   End;
689 
IntToStrnull690 Function IntToStr(x: LongInt):String255;
691 Var
692   s : String255;
693 {$IfDef __GPC__}
694   cs: CString;
695 {$EndIf}
696 
697   Begin
698 {$IfDef __GPC__}
699   GetMem(cs, 256);
700   cs := _itoa(x, cs, 10);
701   s := StrPas(cs);
702   FreeMem(cs, 256);
703 {$Else}
704   Str(x, s);
705 {$EndIf}
706   IntToStr := s;
707   End;
708 
IntToStr0null709 Function IntToStr0(x: LongInt):String255;
710 Var
711   s : String255;
712   i: Byte;
713 
714   Begin
715   s := IntToStr(x);
716   For i := 1 to length(s) do if s[i] = ' ' then s[i] := '0';
717   IntToStr0 := s;
718   End;
719 
IntToStr03null720 Function IntToStr03(x: Word):String3;
721 Var
722   s : String[3];
723   i: Byte;
724 
725   Begin
726   s := IntToStr(x);
727   If (length(s) = 1) then s := '0'+s;
728   If (length(s) = 2) then s := '0'+s;
729   For i := 1 to 3 do if s[i] = ' ' then s[i] := '0';
730   IntToStr03 := s;
731   End;
732 
StrToIntnull733 Function StrToInt(s: String255): LongInt;
734 Var
735  x: LongInt;
736 {$IfDef VIRTUALPASCAL}
737  Error : LongInt;
738 {$Else}
739  Error : Integer;
740 {$EndIf}
741 
742  Begin
743  Val(s, x, Error);
744  If (Error <> 0) then StrToInt := 0 Else StrToInt := x;
745  End;
746 
OctalStrToIntnull747 Function OctalStrToInt(s: String255): LongInt;
748 Var
749  Result: LongInt;
750  CurPos: Byte;
751  Pot8: LongInt;
752  CurNum: Byte;
753  Error: Byte;
754 
755  Begin
756  Error := 0;
757  Result := 0;
758  Pot8 := 1;
759  for CurPos := length(s) downto 1 do
760    Begin
761    Case s[CurPos] of
762      '0': CurNum := 0;
763      '1': CurNum := 1;
764      '2': CurNum := 2;
765      '3': CurNum := 3;
766      '4': CurNum := 4;
767      '5': CurNum := 5;
768      '6': CurNum := 6;
769      '7': CurNum := 7;
770      '8': CurNum := 8;
771      '9': CurNum := 9;
772      else
773        Begin
774        CurNum := 0;
775        Error := CurPos;
776        End;
777      End;
778 
779    Result := Result + (Pot8 * CurNum);
780    Pot8 := Pot8 * 8;
781    End;
782  If (Error = 0) then OctalStrToInt := Result Else OctalStrToInt := -1;
783  End;
784 
FileExistnull785 Function FileExist(fn: String255):Boolean;
786 Var
787   f: File;
788 
789   Begin
790   Assign(f, fn);
791   {$I-} ReSet(f); {$I+}
792   If (IOResult = 0) then
793     Begin
794     {$I-} Close(f); {$I+}
795     FileExist := (IOResult <> 0) or (IOResult = 0);
796     End
797   Else FileExist := False;
798   End;
799 
DirExistnull800 Function DirExist(fn: String255):Boolean;
801 Var
802   SRec: SearchRec;
803 
804   Begin
805   If (fn[2] = ':') and (Length(fn) = 2) then DirExist := True
806   Else If (fn[2] = ':') and (fn[3] = '\') and (Length(fn) = 3) then DirExist := True
807   Else
808    Begin
809    FindFirst(fn, Directory, SRec);
810    DirExist := (DOS.DOSError = 0);
811 {$IfDef OS2}
812    FindClose(SRec);
813 {$EndIf}
814    End;
815   End;
816 
LastPosnull817 Function LastPos(SubStr, S: String255): Byte;
818 Var
819   i: Byte;
820   Begin
821   LastPos := 0;
822   For i := (Length(s)-Length(SubStr)) DownTo 1 do
823     If (Copy(s, i, Length(SubStr)) = SubStr) Then
824     Begin
825     LastPos := i;
826     Break;
827     End;
828   End;
829 
MakeDirnull830 Function MakeDir(Dir: String128): Boolean;
831   Begin
832   {$I-} MkDir(Dir); {$I+}
833   If (IOResult <> 0) Then
834     Begin
835     If (Pos(DirSep, Dir) <> 0) Then
836       Begin
837       MakeDir := MakeDir(Copy(Dir, 1, LastPos(DirSep, Dir) - 1));
838       {$I-} MkDir(Dir); {$I+}
839       If (IOResult = 0) then
840        Begin
841 {$IfDef UNIX}
842        Chmod(Dir, DirPerm);
843 {$EndIf}
844        MakeDir := True;
845        End
846       Else MakeDir := False;
847       End
848     Else MakeDir := False;
849     End
850   Else
851    Begin
852 {$IfDef UNIX}
853    Chmod(Dir, DirPerm);
854 {$EndIf}
855    MakeDir := True;
856    End;
857   End;
858 
RepEnvnull859 Function RepEnv(s: String255):String255;
860 Var
861   s1, s2, s3: String255;
862   i: Byte;
863 
864   Begin
865   s1 := s;
866   i := 1;
867   While (i < Length(s1)) do
868    Begin
869    If (s1[i] = '%') then
870     Begin
871     Delete(s1, i, 1);
872     If not (s1[i] = '%') then
873      Begin
874      s3 := Copy(s1, i, Length(s1)-i+1);
875      If ((Pos('%', s3) = 0) or
876       ((Pos(' ', s3) > 0) and (Pos(' ', s3) < Pos('%', s3)))) then
877       Begin
878       Insert('%', s1, i);
879       End
880      Else
881       Begin
882       s2 := Copy(s1, i, Pos('%', s1) - i);
883       Delete(s1, i, Pos('%', s1) - i + 1);
884       Insert(DOS.GetEnv(UpStr(s2)), s1, i);
885       End;
886      End;
887     End;
888    Inc(i);
889    End;
890   RepEnv := s1;
891   End;
892 
Translatenull893 Function Translate(s: String255; IChar, OChar: Char): String255;
894 Var
895   s1: String255;
896   i: Byte;
897 
898   Begin
899   If (IChar = OChar) then
900     Begin
901     Translate := s;
902     Exit;
903     End;
904   s1 := s;
905   i := Pos(IChar, s1);
906   While (i <> 0) do
907     Begin
908     s1[i] := OChar;
909     i := Pos(IChar, s1);
910     End;
911   Translate := s1;
912   End;
913 
914 
DosAppendnull915 Function DosAppend(var f: File): Integer;
916 Var
917  rc: Integer;
918 
919   Begin
920 {$IfDef SPEED}
921   {$I-} Append(f); {$I+}
922   If (IOResult <> 0) then
923    Begin
924    {$I-} ReWrite(f); {$I+}
925    DOSAppend := IOResult;
926    End
927   Else DosAppend := 0;
928 {$Else}
929   {$I-}
930   ReSet(f);
931   If (IOResult <> 0) then
932    Begin
933    ReWrite(f);
934    rc := IOResult;
935    DosAppend := rc;
936    End
937   Else
938    Begin
939    Seek(f, FileSize(f));
940    DosAppend := IOResult;
941    End;
942   {$I+}
943 {$EndIf}
944   End;
945 
MoveFilenull946 Function MoveFile(OName, NName: String255): Boolean;
947 {$IfDef SPEED}
948 Var
949   rc: APIRet;
950   cs1, cs2: CString;
951 
952   Begin
953   If FileExist(NName) then MoveFile := False
954   Else
955     Begin
956     cs1 := OName;
957     cs2 := NName;
958     rc := DosMove(cs1, cs2);
959     If (rc <> 0) then
960       Begin
961       rc := DosCopy(cs1, cs2, 0);
962       If (rc <> 0) then
963         Begin
964         MoveFile := False;
965         End
966       Else
967         Begin
968         rc := DosDelete(cs1);
969         MoveFile := (rc = 0);
970         End;
971       End
972     Else MoveFile := True;
973     End;
974   End;
975 
976 {$Else}
977  {$IfDef VIRTUALPASCAL}
978 Var
979   rc: LongInt;
980   cs1, cs2: PChar;
981 
982   Begin
983   If FileExist(NName) then MoveFile := False
984   Else
985     Begin
986     GetMem(cs1, 256);
987     GetMem(cs2, 256);
988     StrPCopy(cs1, OName);
989     StrPCopy(cs2, NName);
990     rc := DosMove(cs1, cs2);
991     If (rc <> 0) then
992       Begin
993       rc := DosCopy(cs1, cs2, 0);
994       If (rc <> 0) then
995         Begin
996         MoveFile := False;
997         End
998       Else
999         Begin
1000         rc := DosDelete(cs1);
1001         MoveFile := (rc = 0);
1002         End;
1003       End
1004     Else MoveFile := True;
1005     FreeMem(cs1, 256);
1006     FreeMem(cs2, 256);
1007     End;
1008   End;
1009 
1010  {$Else}
1011 
1012 Var
1013   f: File;
1014 
1015   Begin
1016   If FileExist(NName) then MoveFile := False
1017   Else
1018     Begin
1019     Assign(f, OName);
1020     {$I-} Rename(f, NName); {$I+}
1021     If ((IOResult <> 0) or not FileExist(NName)) then
1022       Begin
1023 {$IfDef UNIX}
1024       shell('cp '+OName+' '+NName);
1025       If ChangePerm then ChMod(NName, FilePerm);
1026 {$Else}
1027       SwapVectors;
1028       Exec(GetEnv('COMSPEC'), '/C copy '+OName+' '+NName);
1029       SwapVectors;
1030 {$EndIf}
1031       If (FileExist(OName) and FileExist(NName)) then
1032         Begin
1033         Assign(f, OName);
1034         {$I-} Erase(f); {$I+}
1035         MoveFile := (IOResult = 0);
1036         End
1037       Else MoveFile := False;
1038       End
1039     Else MoveFile := True;
1040     End;
1041   End;
1042  {$EndIf}
1043 {$EndIf}
1044 
RepFilenull1045 Function RepFile(OName, NName: String255): Boolean;
1046 {$IfDef SPEED}
1047 Var
1048   rc: APIRet;
1049   cs1, cs2: CString;
1050 
1051   Begin
1052   cs1 := OName;
1053   cs2 := NName;
1054   rc := DosMove(cs1, cs2);
1055   If (rc <> 0) then
1056     Begin
1057     rc := DosCopy(cs1, cs2, 1);
1058     If (rc <> 0) then
1059       Begin
1060       RepFile := False;
1061       End
1062     Else
1063       Begin
1064       rc := DosDelete(cs1);
1065       RepFile := (rc = 0);
1066       End;
1067     End
1068   Else RepFile := True;
1069   End;
1070 
1071 {$Else}
1072 Var
1073   f: File;
1074 
1075   Begin
1076   Assign(f, OName);
1077   {$I-} Rename(f, NName); {$I+}
1078   If ((IOResult <> 0) or not FileExist(NName)) then
1079     Begin
1080 {$IfDef UNIX}
1081     shell('cp '+OName+' '+NName);
1082     If ChangePerm then Chmod(NName, FilePerm);
1083 {$Else}
1084     SwapVectors;
1085     Exec(GetEnv('COMSPEC'), '/C copy '+OName+' '+NName);
1086     SwapVectors;
1087 {$EndIf}
1088     If (FileExist(OName) and FileExist(NName)) then
1089       Begin
1090       Assign(f, OName);
1091       {$I-} Erase(f); {$I+}
1092       RepFile := (IOResult = 0);
1093       End
1094     Else RepFile := False;
1095     End
1096   Else RepFile := True;
1097   End;
1098 {$EndIf}
1099 
CopyFilenull1100 Function CopyFile(OName, NName: String255): Boolean;
1101 {$IfDef SPEED}
1102 Var
1103   cs1, cs2: CString;
1104 
1105   Begin
1106   cs1 := OName;
1107   cs2 := NName;
1108   CopyFile := (DosCopy(cs1, cs2, 0) = 0);
1109   End;
1110 
1111 {$Else}
1112 
1113   Begin
1114 {$IfDef UNIX}
1115   shell('cp '+OName+' '+NName);
1116   If ChangePerm then Chmod(NName, FilePerm);
1117 {$Else}
1118   SwapVectors;
1119   Exec(GetEnv('COMSPEC'), '/C copy '+OName+' '+NName);
1120   SwapVectors;
1121 {$EndIf}
1122   CopyFile := FileExist(NName);
1123   End;
1124 {$EndIf}
1125 
DelFilenull1126 Function DelFile(Name: String255): Boolean;
1127 Var
1128   f: File;
1129 
1130   Begin
1131   Assign(f, Name);
1132   {$I-} Erase(f); {$I+}
1133   DelFile := ((IOResult = 0) and not FileExist(Name));
1134   End;
1135 
TruncFilenull1136 Function TruncFile(Name: String255): Boolean;
1137 Var
1138   f: File;
1139 
1140   Begin
1141   Assign(f, Name);
1142   {$I-} ReWrite(f); {$I+}
1143   If (IOResult = 0) then
1144    Begin
1145    {$I-} Close(f); {$I+}
1146    TruncFile := (IOResult = 0);
1147    End
1148   Else TruncFile := False;
1149   End;
1150 
CreateSemnull1151 Function CreateSem(Name: String255): Boolean;
1152 Var
1153   f: Text;
1154   i: Integer;
1155 
1156   Begin
1157   Assign(f, Name);
1158   {$I-} ReWrite(f); {$I+}
1159   If (IOResult = 0) then
1160    Begin
1161    {$I-} WriteLn(f); {$I+}
1162    i := IOResult;
1163    {$I-} Close(f); {$I+}
1164 {$IfDef UNIX}
1165    Chmod(Name, FilePerm);
1166 {$EndIf}
1167    CreateSem := (IOResult = 0) and (i = 0);
1168    End
1169   Else CreateSem := False;
1170   End;
1171 
1172 {$IfNDef SPEED}
1173 Procedure GetFTime2(var f; var Year, Month, Day, Hour, Min, Sec: Word);
1174 Var
1175   i: LongInt;
1176 {$IfDef VIRTUALPASCAL}
1177   DT: DOS.DateTime;
1178 {$Else}
1179   DT: DateTime;
1180 {$EndIf}
1181 
1182   Begin
1183   GetFTime(f, i);
1184   UnPackTime(i, DT);
1185   Year := DT.Year;
1186   Month := DT.Month;
1187   Day := DT.Day;
1188   Hour := DT.Hour;
1189   Min := DT.Min;
1190   Sec := DT.Sec;
1191   End;
1192 {$EndIf}
1193 
1194 Procedure GetFileTime(Name: String255; var Year, Month, Day, Hour, Min, Sec: Word);
1195 Var
1196   f: File;
1197 
1198   Begin
1199   Assign(f, Name);
1200   {$I-} ReSet(f); {$I-}
1201   If (IOResult = 0) then
1202     Begin
1203     GetFTime2(f, Year, Month, Day, Hour, Min, Sec);
1204     {$I-} Close(f); {$I+}
1205     If (IOResult = 0) then ;
1206     End;
1207   End;
1208 
GetFSizenull1209 Function GetFSize(Name: String255): LongInt;
1210 Var
1211   f: File of Byte;
1212 
1213   Begin
1214   Assign(f, Name);
1215   {$I-} ReSet(f); {$I+}
1216   If (IOResult = 0) then
1217     Begin
1218     GetFSize := FileSize(f);
1219     {$I-} Close(f); {$I+}
1220     If (IOResult = 0) then ;
1221     End
1222   Else GetFSize := 0;
1223   End;
1224 
leapyearnull1225 Function leapyear (c, y : Byte) : Boolean;
1226 begin
1227   if (y and 3) <> 0 then
1228           leapyear := False
1229   else
1230         if y <> 0 then
1231           leapyear := True
1232   else
1233         if (c and 3) = 0 then
1234           leapyear := True
1235   else
1236           leapyear := False;
1237 end;
1238 
DaysInMonthnull1239 Function DaysInMonth (DT:TimeTyp; m : Byte) : Byte;
1240 begin
1241   if m = 2 then
1242           if leapyear(DT.Year div 100, DT.Year mod 100) then
1243                   DaysInMonth := 29
1244     else
1245                   DaysInMonth := 28
1246   else
1247           DaysInMonth := 30 + (($15AA shr m) and 1);
1248 end;
1249 
DayOfYearnull1250 Function DayOfYear (DT: TimeTyp) : Word;
1251 Var i, j : Integer;
1252 begin
1253   j := DT.Day;
1254   If (DT.Month > 1) then For i := 1 to pred(DT.Month) do
1255    j := j + DaysInMonth(DT,i);
1256   DayOfYear := j;
1257 end;
1258 
CRC16null1259 function CRC16(s:string255):word;  { By Kevin Cooney }
1260 var
1261   crc : longint;
1262   t,r : byte;
1263 begin
1264   crc:=0;
1265   for t:=1 to length(s) do
1266   begin
1267     crc:=(crc xor (ord(s[t]) shl 8));
1268     for r:=1 to 8 do
1269       if (crc and $8000)>0 then
1270         crc:=((crc shl 1) xor $1021)
1271           else
1272             crc:=(crc shl 1);
1273   end;
1274   CRC16:=(crc and $FFFF);
1275 end;
1276 
GetCRC16null1277 Function GetCRC16(fn: String255): Word;
1278 Type
1279  PBuff = ^TBuff;
1280  TBuff = Array[1..65530] of Byte;
1281 
1282 Var
1283  f: File;
1284  Buf: PBuff;
1285 {$IfDef SPEED}
1286  nr: LongWord;
1287 {$Else}
1288  {$IfDef VIRTUALPASCAL}
1289  nr: LongInt;
1290  {$Else}
1291  nr: Word;
1292  {$EndIf}
1293 {$EndIf}
1294  i, j: Word;
1295  CRC: Longint;
1296 
1297  Begin
1298  CRC := $0000;
1299  Assign(f, fn);
1300  {$I-} ReSet(f, 1); {$I+}
1301  If (IOResult <> 0) then
1302   Begin
1303   GetCRC16 := $FFFF;
1304   Exit;
1305   End;
1306  New(Buf);
1307   Repeat
1308   BlockRead(f, Buf^, 65530, nr);
1309   If (nr > 0) then
1310    Begin
1311    For i := 1 to nr do
1312     Begin
1313     crc:=(crc xor (ord(Buf^[i]) shl 8));
1314     for j:=1 to 8 do
1315      if (crc and $8000)>0 then crc:=((crc shl 1) xor $1021)
1316      else crc:=(crc shl 1);
1317     End;
1318    End;
1319   Until (nr < 65530);
1320  GetCRC16 := (CRC and $FFFF);
1321  Dispose(Buf);
1322  Close(f);
1323  End;
1324 
1325 Begin
1326 {$IfDef UNIX}
1327 If (DOS.GetEnv('UMASK') <> '') then
1328  Begin
1329  FilePerm := OctalStrToInt(DOS.GetEnv('UMASK'));
1330  FilePerm := 511 and not FilePerm;
1331  DirPerm := FilePerm;
1332  End
1333 Else
1334  Begin
1335  FilePerm := 493; {octal 755}
1336  DirPerm := 493; {octal 755}
1337  End;
1338 {$Else}
1339 FilePerm := 0; DirPerm := 0;
1340 {$EndIf}
1341 ChangePerm := False;
1342 end.
1343 
1344