home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Multimed / Multimed.zip / mp3osr05.zip / src / wizard.pas < prev   
Pascal/Delphi Source File  |  1999-12-25  |  34KB  |  1,582 lines
  1. {
  2.  Common stuff for any good programmer. ;-)
  3.  
  4.  version 2.13, 02/11/1999
  5.   replace/replaceex code rewritten
  6.  
  7.  version 2.12, 24/08/1999
  8.   sysutils free [os2, w32]
  9.  
  10.  version 2.11, 08/07/1999
  11.   ToJulian, FromJulian, GetCurrentJulian, FixTabs added
  12.  
  13.  version 2.10, 06/06/1999
  14.   EraseFile added
  15.  
  16.  version 2.09, 11/05/1999
  17.   ClrIO, __IOcheck, __IOresult, __IOclear added
  18.  
  19.  version 2.08, 15/04/1999
  20.   JustFileNameOnly added
  21.   GetAttr, SetAttr bugs
  22.  
  23.  version 2.07, 11/04/1999
  24.   GrowDate added
  25.  
  26.  version 2.06
  27.   GetFileSize bugfixed
  28.  
  29.  version 2.05
  30.   MakeFmt added
  31.  
  32.  version 2.04
  33.   GetBinkDateTime added
  34.  
  35.  version 2.03
  36.   DELPHI support removed, only BP 7.0 and VP 2.0 still remain
  37.  
  38.  version 2.02
  39.   added CheckWildcard
  40.  
  41.  version 2.01
  42.   added TextFileSize, TextFilePos, TextSeek
  43.  
  44.  version 2.0
  45.   complete rewritten
  46.  
  47.  (q) by sk // [rAN] [2:5033/27], 1999.
  48. }
  49. {&Delphi+,CDecl-}
  50.  
  51. unit Wizard;
  52.  
  53. {$IFDEF DPMI}
  54.  {$DEFINE DOS}
  55. {$ENDIF}
  56. {$IFDEF MSDOS}
  57.  {$DEFINE DOS}
  58. {$ENDIF}
  59.  
  60. {$IFDEF VIRTUALPASCAL}
  61.  {$H-}
  62. {$ENDIF}
  63.  
  64. interface
  65. uses
  66.      {$IFDEF VIRTUALPASCAL}
  67.      vpSysLow,
  68.      {$ENDIF}
  69.  
  70.      Dos;
  71.  
  72. type
  73.  CharSet = Set Of Char;
  74.  
  75. {$IFDEF VIRTUALPASCAL}
  76.  xWord = Longint;
  77.  xInteger = Longint;
  78. {$ELSE}
  79.  xWord = Word;
  80.  xInteger = Integer;
  81. {$ENDIF}
  82.  
  83. var
  84.  Replaced: Boolean; { True if Replace/ReplaceEx did anything }
  85.  
  86. const
  87.  Months: Array[1..12] Of String[3] =
  88.   ('Jan','Feb','Mar','Apr','May','Jun',
  89.    'Jul','Aug','Sep','Oct','Nov','Dec');
  90.  
  91.  Days: array[Boolean, 1..12] of Longint =
  92.         ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
  93.          (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));
  94.  
  95. (* Procedures/functions definition *)
  96.  
  97. { Strings and numbers stuff }
  98.  
  99. function  Center(S: String; Width: Byte): String;
  100. function  CenterCh(S: String; Ch: Char; Width: Byte): String;
  101. function  ExtractWord(N: Byte; const S: String; WordDelims: CharSet): String;
  102. function  GetAllAfterChar(const S: String; Spc: Byte; Ch: Char): String;
  103. function  GetAllAfterSpace(const S: String; Spc: Byte): String;
  104. function  GetPString(S: Pointer): String;
  105. function  HexB(B: Byte): String;
  106. function  HexL(L: Longint): String;
  107. function  HexPtr(P: Pointer): String;
  108. function  HexW(W: Word): String;
  109. function  LTrim(S: String): String;
  110. function  LeftPad(const S: String; Len: Byte): String;
  111. function  LeftPadCh(const S: String; Ch: Char; Len: Byte): String;
  112. function  Long2Str(L: Longint): String;
  113. function  Long2StrFmt(L: Longint): String;
  114. function  Pad(const S: String; Len: Byte): String;
  115. function  PadCh(const S: String; Ch: Char; Len: Byte): String;
  116. function  RTrim(S: String): String;
  117. function  Replace(S: String; const A, B: String): String;
  118. function  StLoCase(S: String): String;
  119. function  StUpCase(S: String): String;
  120. function  Str2Char(const S: String): Char;
  121. function  Str2Number(const S: String): Boolean;
  122. function  Trim(S: String): String;
  123. function  WordCount(const S: String; WordDelims: CharSet): Byte;
  124. procedure GetPStringEx(S: Pointer; var R: String);
  125. procedure ReplaceChar(var S: String; Source, Dest: Char);
  126. procedure ReplaceEx(var S: String; A: String; const B: String);
  127. procedure StLocaseEx(var S: String);
  128. procedure StUpcaseEx(var S: String);
  129. procedure Str2Byte(const S: String; var A: Byte);
  130. procedure Str2Longint(const S: String; var A: Longint);
  131. procedure Str2Word(const S: String; var A: Word);
  132. procedure Str2XWord(const S: String; var A: XWord);
  133. procedure TrimEx(var S: String);
  134.  
  135. { Files stuff }
  136.  
  137. function  AddBackSlash(S: String): String;
  138. function  ExistDir(const S: String): Boolean;
  139. function  ExistFile(const S: String): Boolean;
  140. function  FExpand(const S: String): String;
  141. function  ForceExtension(const Name, Ext: String): String;
  142. function  GetAttr(const FName: String): Longint;
  143. function  GetFileDate(const FName: String): Longint;
  144. function  GetFileSize(const S: String): Longint;
  145. function  GetStamp(const FName: String): Longint;
  146. function  HasExtension(const Name: String; var DotPos: Word): Boolean;
  147. function  JustExtension(const Name: String): String;
  148. function  JustFilename(const PathName: String): String;
  149. function  JustFilenameOnly(const PathName: String): String;
  150. function  JustPathname(const PathName: String): String;
  151. function  RemoveBackSlash(S: String): String;
  152. procedure SetAttr(const FName: String; K: Longint);
  153. procedure SetStamp(const FName: String; K: Longint);
  154.  
  155. { Other stuff }
  156.  
  157. function  Clock: Longint;
  158. function  DayOfWeek (y, m, d: WORD): WORD;
  159. function  StackOverflow: boolean;
  160. function  TimeFix: Longint;
  161. function  _Date(L: Longint): String;
  162. function  _Time(L: Longint): String;
  163. procedure IWannaDate(var D, M, Y: Word);
  164. procedure IWannaTime(var H, M, S: Word);
  165. procedure TimeDif(L: Longint; var DT: DateTime);
  166. procedure Wait(const ms: Longint);
  167. procedure GrowDate(var Date: Longint; const Delta: Longint);
  168.  
  169. { FidoNet stuff :-) }
  170.  
  171. function  GetPktDateTime: String;
  172. function  GetPktDateTimeCustom(Day, Month, Year, Hour, Min, Sec: Word): String;
  173. procedure ParsePktDateTime(S: String; var Day, Month, Year, Hour, Min, Sec, Dow: XWord);
  174.  
  175. { Multiplatform stuff }
  176.  
  177. {$IFDEF DOS}
  178. procedure FindClose(var SR: SearchRec);
  179. {$ENDIF}
  180.  
  181. { Added in 2.01 }
  182. function TextSeek(var F: Text; Target: LongInt): Boolean;
  183. function TextFileSize(var F: Text) : LongInt;
  184. function TextPos(var F: Text): LongInt;
  185.  
  186. { Added in 2.02 }
  187. function CheckWildcard(S, Mask: String): Boolean;
  188.  
  189. { Added in 2.04 }
  190. function GetBinkDateTime: String;
  191.  
  192. { Added in 2.05 }
  193. function MakeFmt(const R: String): String;
  194.  
  195. { Added in 2.09 }
  196. procedure ClrIO;
  197. function __IOcheck: Boolean;
  198. function __IOerror: String;
  199. procedure __IOclear;
  200.  
  201. { Added in 2.10 }
  202.  
  203. function EraseFile(const FName: String): Boolean;
  204.  
  205. { Added in 2.11 }
  206.  
  207. function ToJulian(_Day, _Month, _Year: Longint): LongInt;
  208. procedure FromJulian(JulianDN: LongInt; var Year, Month, Day: Longint);
  209. function GetCurrentJulian: Longint;
  210. procedure FixTabs(var S: String);
  211.  
  212. implementation
  213.  
  214. (* Internal Constants *)
  215.  
  216. const
  217.  DosDelimSet: Set Of Char = ['\', ':', #0];
  218.  
  219.  Digits: array[0..$F] of Char = '0123456789ABCDEF';
  220.  
  221. var
  222.  ValL: XInteger;
  223.  
  224. type
  225.  Long = record
  226.   LowWord, HighWord: Word;
  227.  end;
  228.  DateTimeRec = record
  229.   FTime,FDate: Word;
  230.  end;
  231.  
  232. {$IFNDEF VIRTUALPASCAL}
  233.  PTextBuffer = ^TTextBuffer;
  234.  TTextBuffer = array[0..65520] of Byte;
  235.  TText = record
  236.   Handle: Word;
  237.   Mode: Word;
  238.   BufSize: Word;
  239.   Priv: Word;
  240.   BufPos: Word;
  241.   BufEnd: Word;
  242.   BufPtr: PTextBuffer;
  243.   OpenProc: Pointer;
  244.   InOutProc: Pointer;
  245.   FlushProc: Pointer;
  246.   CloseProc: Pointer;
  247.   UserData: array[1..16] of Byte;
  248.   Name: array[0..79] of Char;
  249.   Buffer: array[0..127] of Char;
  250.  end;
  251.  
  252. const
  253.  FMClosed      = $D7B0;
  254.  FMInput       = $D7B1;
  255.  FMOutput      = $D7B2;
  256.  FMInOut       = $D7B3;
  257. {$ENDIF}
  258.  
  259. const
  260.  C1970         = 2440588;
  261.  D0            = 1461;
  262.  D1            = 146097;
  263.  D2            = 1721119;
  264.  
  265. (* Internal stuff *)
  266. function UpCase(C: Char): Char;
  267.  begin
  268.   case c of
  269.    'a'..'z': c:=chr(ord(c)-(97-65));
  270.    'á'..'»': c:=chr(ord(c)-(160-128));
  271.    'α'..'∩': c:=chr(ord(c)-(224-144));
  272.    '±': c:='≡';
  273.   end;
  274.   upCase:=c;
  275.  end;
  276.  
  277. function LoCase(c: Char): Char;
  278.  begin
  279.   case c of
  280.    'A'..'Z': c:=chr(ord(c)+(97-65));
  281.    'Ç'..'Å': c:=chr(ord(c)+(160-128));
  282.    'É'..'ƒ': c:=chr(ord(c)+(224-144));
  283.    '≡': c:='±';
  284.   end;
  285.   loCase:=c;
  286.  end;
  287.  
  288. (* Procedures and functions *)
  289.  
  290. { Strings and numbers stuff }
  291.  
  292. function Center(S: String; Width: Byte): String;
  293.  begin
  294.   Center:=CenterCh(S, ' ', Width);
  295.  end;
  296.  
  297. function CenterCh(S: String; Ch: Char; Width: Byte): String;
  298.  var
  299.   O: String;
  300.   SLen: Byte Absolute S;
  301.  begin
  302.   if SLen >= Width then
  303.    CenterCh := S
  304.   else
  305.    if SLen < 255 then
  306.     begin
  307.      O[0]:=Chr(Width);
  308.      FillChar(O[1], Width, Ch);
  309.      Move(S[1], O[Succ((Width-SLen) shr 1)], SLen);
  310.      CenterCh:=O;
  311.     end;
  312.  end;
  313.  
  314. function ExtractWord(N: Byte; const S: String; WordDelims: CharSet): String;
  315.   var
  316.     I: Word;                 {!!.12}
  317.     Count, Len: Byte;
  318.     SLen: Byte absolute S;
  319.   begin
  320.     Count := 0;
  321.     I := 1;
  322.     Len := 0;
  323.     ExtractWord[0] := #0;
  324.  
  325.     while (I <= SLen) and (Count <> N) do begin
  326.       {skip over delimiters}
  327.       while (I <= SLen) and (S[I] in WordDelims) do
  328.         Inc(I);
  329.  
  330.       {if we're not beyond end of S, we're at the start of a word}
  331.       if I <= SLen then
  332.         Inc(Count);
  333.  
  334.       {find the end of the current word}
  335.       while (I <= SLen) and not(S[I] in WordDelims) do begin
  336.         {if this is the N'th word, add the I'th Character to Tmp}
  337.         if Count = N then begin
  338.           Inc(Len);
  339.           ExtractWord[0] := Char(Len);
  340.           ExtractWord[Len] := S[I];
  341.         end;
  342.  
  343.         Inc(I);
  344.       end;
  345.     end;
  346.   end;
  347.  
  348. function GetAllAfterChar(const S: String; Spc: Byte; Ch: Char): String;
  349.  var
  350.   K, L: Byte;
  351.   Out: String;
  352.  begin
  353.   Out:='';
  354.   L:=0;
  355.   for K:=1 to Length(S) do
  356.    if L >= Spc then
  357.     Out:=Out + S[K]
  358.    else
  359.     if S[K] = Ch then
  360.      Inc(L);
  361.   GetAllAfterChar:=Out;
  362.  end;
  363.  
  364. function GetAllAfterSpace(const S: String; Spc: Byte): String;
  365.  var
  366.   K, L: Byte;
  367.   Out: String;
  368.  begin
  369.   Out:='';
  370.   L:=0;
  371.   for K:=1 to Length(S) do
  372.    if L >= Spc then
  373.     Out:=Out + S[K]
  374.    else
  375.     if S[K] = ' ' then Inc(L);
  376.   GetAllAfterSpace:=Out;
  377.  end;
  378.  
  379. function GetPString(S: Pointer): String;
  380.  var
  381.   R: String;
  382.  begin
  383.   GetPStringEx(S, R);
  384.  
  385.   GetPString:=R;
  386.  end;
  387.  
  388. function HexB(B: Byte): String;
  389.  begin
  390.   HexB[0]:=#2;
  391.   HexB[1]:=Digits[B shr 4];
  392.   HexB[2]:=Digits[B and $F];
  393.  end;
  394.  
  395. function HexL(L: Longint): String;
  396.  begin
  397.   with Long(L) do
  398.    HexL:=HexW(HighWord) + HexW(LowWord);
  399.  end;
  400.  
  401. function HexPtr(P: Pointer): String;
  402.  var
  403.   Z: record S,O: Word end absolute P;
  404.  begin
  405.   HexPtr:=HexW(Z.S) + ':' + HexW(Z.o);
  406.  end;
  407.  
  408. function HexW(W: Word): String;
  409.  begin
  410.   HexW[0]:=#4;
  411.   HexW[1]:=Digits[hi(W) shr 4];
  412.   HexW[2]:=Digits[hi(W) and $F];
  413.   HexW[3]:=Digits[lo(W) shr 4];
  414.   HexW[4]:=Digits[lo(W) and $F];
  415.  end;
  416.  
  417. function LTrim(S: String): String;
  418.  begin
  419.   while (Length(S)<>0) and (S[1]=' ') do Delete(S,1,1);
  420.   LTrim:=S;
  421.  end;
  422.  
  423. function LeftPad(const S: String; Len: Byte): String;
  424.  begin
  425.   LeftPad:=LeftPadCh(S, ' ', Len);
  426.  end;
  427.  
  428. function LeftPadCh(const S: String; Ch: Char; Len: Byte): String;
  429.  var
  430.   O: String;
  431.   SLen: Byte Absolute S;
  432.  begin
  433.   if Length(S) >= Len then
  434.    LeftPadCh:=S
  435.   else
  436.    if SLen < 255 then
  437.     begin
  438.      O[0]:=Chr(Len);
  439.      Move(S[1], O[Succ(Word(Len))-SLen], SLen);
  440.      FillChar(O[1], Len - SLen, Ch);
  441.      LeftPadCh:=O;
  442.     end;
  443.  end;
  444.  
  445. function Long2Str(L: Longint): String;
  446.  var
  447.   S: String;
  448.  begin
  449.   Str(L, S);
  450.  
  451.   Long2Str:=S;
  452.  end;
  453.  
  454. function Long2StrFmt(L: Longint): String;
  455.  begin
  456.   Long2StrFmt:=MakeFmt(Long2Str(L));
  457.  end;
  458.  
  459. function Pad(const S: String; Len: Byte): String;
  460.  begin
  461.   Pad:=PadCh(S, ' ', Len);
  462.  end;
  463.  
  464. function PadCh(const S: String; Ch: Char; Len: Byte): String;
  465.  var
  466.   O: String;
  467.   SLen: Byte Absolute S;
  468.  begin
  469.   if Length(S) >= Len then
  470.    PadCh:=S
  471.   else
  472.    begin
  473.     O[0]:=Chr(Len);
  474.  
  475.     Move(S[1], O[1], SLen);
  476.  
  477.     if SLen < 255 then
  478.      FillChar(O[Succ(SLen)], Len - SLen, Ch);
  479.  
  480.     PadCh:=O;
  481.    end;
  482.  end;
  483.  
  484. function RTrim(S: String): String;
  485.  begin
  486.   while (Length(S)<>0) and (S[Length(S)]=' ') do
  487.    Dec(S[0]);
  488.  
  489.   RTrim:=S;
  490.  end;
  491.  
  492. function Replace(S: String; const A, B: String): String;
  493.  begin
  494.   ReplaceEx(S, A, B);
  495.  
  496.   Replace:=S;
  497.  end;
  498.  
  499. function StLoCase(S: String): String;
  500.  var
  501.   k: byte;
  502.  begin
  503.   for k:=1 to Length(S) do
  504.    s[k]:=locase(s[k]);
  505.   stLocase:=S;
  506.  end;
  507.  
  508. function StUpCase(S: String): String;
  509.  var
  510.   k: byte;
  511.  begin
  512.   for k:=1 to Length(S) do
  513.    s[k]:=upcase(s[k]);
  514.   stUpcase:=S;
  515.  end;
  516.  
  517. function Str2Char(const S: String): Char;
  518.  begin
  519.   if S[0] = #0 then
  520.    Str2Char:=#0
  521.   else
  522.    Str2Char:=S[1];
  523.  end;
  524.  
  525. function Str2Number(const S: String): Boolean;
  526.  var
  527.   X: Longint;
  528.   C: xInteger;
  529.  begin
  530.   Val(S, X, C);
  531.   Str2Number:=C = 0;
  532.  end;
  533.  
  534. function Trim(S: String): String;
  535.  begin
  536.   while (Length(S)<>0) and (S[1]=' ') do Delete(S,1,1);
  537.   while (Length(S)<>0) and (S[Length(S)]=' ') do Dec(S[0]);
  538.   Trim:=S;
  539.  end;
  540.  
  541. function WordCount(const S: String; WordDelims: CharSet): Byte;
  542.  var
  543.   Count: Byte;
  544.   I: Word;
  545.   SLen: Byte absolute S;
  546.  begin
  547.   Count := 0;
  548.   I := 1;
  549.   while I <= SLen do begin
  550.    while (I <= SLen) and (S[I] in WordDelims) do
  551.     Inc(I);
  552.     if I <= SLen then Inc(Count);
  553.     while (I <= SLen) and not(S[I] in WordDelims) do
  554.      Inc(I);
  555.     end;
  556.   WordCount := Count;
  557.  end;
  558.  
  559. procedure GetPStringEx(S: Pointer; var R: String);
  560.  type
  561.   PString = ^String;
  562.  begin
  563.   if S = Nil then
  564.    R[0]:=#0
  565.   else
  566.    Move(S^, R, Length(PString(S)^) + 1);
  567.  end;
  568.  
  569. procedure ReplaceChar(var S: String; Source, Dest: Char);
  570.  var
  571.   K: Byte;
  572.  begin
  573.   for K:=1 to Length(S) do
  574.    if S[K] = Source then
  575.     S[K]:=Dest;
  576.  end;
  577.  
  578. procedure ReplaceEx(var S: String; A: String; const B: String);
  579.  var
  580.   K, L: Byte;
  581.  begin
  582.   StUpcaseEx(A);
  583.  
  584.   Replaced:=False;
  585.  
  586.   K:=Pos(A, StUpcase(S));
  587.   L:=0;
  588.  
  589.   while K <> 0 do
  590.    begin
  591.     Replaced:=True;
  592.  
  593.     Delete(S, K, Length(A));
  594.  
  595.     Insert(B, S, K);
  596.  
  597.     L:=K + Length(B);
  598.  
  599.     K:=Pos(A, StUpcase(Copy(S, L, 255)));
  600.  
  601.     if K <> 0 then
  602.      begin
  603.       Dec(K);
  604.  
  605.       Inc(K, L);
  606.      end;
  607.    end;
  608.  end;
  609.  
  610. procedure StLocaseEx(var S: String);
  611.  var
  612.   K: Byte;
  613.  begin
  614.   for k:=1 to Length(S) do
  615.    s[k]:=locase(s[k]);
  616.  end;
  617.  
  618. procedure StUpcaseEx(var S: String);
  619.  var
  620.   k: byte;
  621.  begin
  622.   for k:=1 to Length(S) do
  623.    s[k]:=upcase(s[k]);
  624.  end;
  625.  
  626. procedure Str2Byte(const S: String; var A: Byte);
  627.  begin
  628.   if S = '' then
  629.    A:=0
  630.   else
  631.    Val(S, A, ValL);
  632.  end;
  633.  
  634. procedure Str2Longint(const S: String; var A: Longint);
  635.  begin
  636.   if S='' then
  637.    A:=0
  638.   else
  639.    Val(S, A, ValL);
  640.  end;
  641.  
  642. procedure Str2Word(const S: String; var A: Word);
  643.  begin
  644.   if S='' then
  645.    A:=0
  646.   else
  647.    Val(S, A, ValL);
  648.  end;
  649.  
  650. procedure Str2XWord(const S: String; var A: XWord);
  651.  begin
  652.   if S='' then
  653.    A:=0
  654.   else
  655.    Val(S, A, ValL);
  656.  end;
  657.  
  658. procedure TrimEx(var S: String);
  659.  begin
  660.   while (Length(S)<>0) and (S[1]=' ') do Delete(S,1,1);
  661.   while (Length(S)<>0) and (S[Length(S)]=' ') do Dec(S[0]);
  662.  end;
  663.  
  664. { Files stuff }
  665.  
  666. function AddBackSlash(S: String): String;
  667.  begin
  668.   if S[0]<>#0 then
  669.    if S[Length(S)]<>'\' then S:=S+'\';
  670.   AddBackSlash:=S;
  671.  end;
  672.  
  673. function ExistDir(const S: String): Boolean;
  674.  var
  675.   SR: SearchRec;
  676.  begin
  677.   FindFirst(AddBackSlash(S) + '*.*', AnyFile, SR);
  678.   ExistDir:=DosError = 0;
  679.   FindClose(Sr);
  680.  end;
  681.  
  682. function ExistFile(const S: String): Boolean;
  683.  var
  684.   F: File;
  685.   A: XWord;
  686.  begin
  687.   Assign(F, S);
  688.  
  689.   GetFAttr(F,A);
  690.  
  691.   ExistFile:=DosError = 0;
  692.  end;
  693.  
  694. function FExpand(const S: String): String;
  695.  begin
  696.   FExpand:=Dos.FExpand(S);
  697.  end;
  698.  
  699. function ForceExtension(const Name, Ext: String): String;
  700.  var
  701.   DotPos: Word;
  702.  begin
  703.   if HasExtension(Name, DotPos) then
  704.    ForceExtension := Copy(Name, 1, DotPos)+Ext
  705.   else
  706.    ForceExtension := Name+'.'+Ext;
  707.  end;
  708.  
  709. function GetAttr(const FName: String): Longint;
  710.  var
  711.   F: File;
  712.   K: xWord;
  713.  begin
  714.   Assign(F, FName);
  715.  
  716.   GetFAttr(F, K);
  717.  
  718.   GetAttr:=K;
  719.  end;
  720.  
  721. function GetFileDate(const FName: String): Longint;
  722.  var
  723.   SR: SearchRec;
  724.  begin
  725.   FindFirst(FName, AnyFile, SR);
  726.  
  727.   if DosError <> 0 then
  728.    GetFileDate:=-1
  729.   else
  730.    GetFileDate:=SR.Time;
  731.  
  732.   FindClose(Sr);
  733.  end;
  734.  
  735. function GetFileSize(const S: String): Longint;
  736.  var
  737.   SR: SearchRec;
  738.  begin
  739.   FindFirst(S, AnyFile, SR);
  740.   if DosError <> 0 then
  741.    GetFileSize:=-1
  742.   else
  743.    GetFileSize:=SR.Size;
  744.   FindClose(Sr);
  745.  end;
  746.  
  747. function GetStamp(const FName: String): Longint;
  748.  var
  749.   F: File;
  750.   K: Longint;
  751.  begin
  752.   if IOResult <> 0 then;
  753.  
  754.   Assign(F, FName);
  755.   Reset(F);
  756.  
  757.   if IOResult <> 0 then
  758.    begin
  759.     GetStamp:=-1;
  760.  
  761.     Exit;
  762.    end;
  763.  
  764.   GetFTime(F, K);
  765.  
  766.   Close(F);
  767.  
  768.   GetStamp:=K;
  769.  
  770.   if IOResult <> 0 then;
  771.  end;
  772.  
  773. function HasExtension(const Name: String; var DotPos: Word): Boolean;
  774.  var
  775.   I: Word;
  776.  begin
  777.   DotPos:=0;
  778.   for I:=Length(Name) downto 1 do
  779.    if (Name[I] = '.') and (DotPos = 0) then
  780.     DotPos:=I;
  781.   HasExtension:=(DotPos > 0) and (Pos('\', Copy(Name, Succ(DotPos), 64)) = 0);
  782.  end;
  783.  
  784. function JustExtension(const Name: String): String;
  785.  var
  786.   DotPos: Word;
  787.  begin
  788.   if HasExtension(Name, DotPos) then
  789.    JustExtension:=Copy(Name, Succ(DotPos), 3)
  790.   else
  791.    JustExtension[0]:=#0;
  792.  end;
  793.  
  794. function JustFilename(const PathName: String): String;
  795.  var
  796.   I: Word;
  797.  begin
  798.   I:=Succ(Word(Length(PathName)));
  799.   repeat
  800.    Dec(I);
  801.   until (PathName[I] in DosDelimSet) or (I = 0);
  802.   JustFilename:=Copy(PathName, Succ(I), 64);
  803.  end;
  804.  
  805. function JustPathname(const PathName: String): String;
  806.  var
  807.   I: Word;
  808.  begin
  809.   I := Succ(Word(Length(PathName)));
  810.   repeat
  811.    Dec(I);
  812.   until (PathName[I] in DosDelimSet) or (I = 0);
  813.   if I = 0 then
  814.    JustPathname[0] := #0
  815.   else
  816.    if I = 1 then JustPathname := PathName[1]
  817.   else
  818.    if (PathName[I] = '\') then
  819.     begin
  820.      if PathName[Pred(I)] = ':' then
  821.       JustPathname := Copy(PathName, 1, I)
  822.      else
  823.       JustPathname := Copy(PathName, 1, Pred(I));
  824.     end
  825.    else
  826.     JustPathname := Copy(PathName, 1, I);
  827.  end;
  828.  
  829. function RemoveBackSlash(S: String): String;
  830.  begin
  831.   S:=AddBackSlash(S);
  832.   if S[0] > #3 then Dec(S[0]);
  833.   RemoveBackSlash:=S;
  834.  end;
  835.  
  836. procedure SetAttr(const FName: String; K: Longint);
  837.  var
  838.   F: File;
  839.  begin
  840.   Assign(F, FName);
  841.  
  842.   SetFAttr(F, K);
  843.  
  844.   if IOResult <> 0 then;
  845.  end;
  846.  
  847. procedure SetStamp(const FName: String; K: Longint);
  848.  var
  849.   F: File;
  850.  begin
  851.   if IOResult <> 0 then;
  852.  
  853.   Assign(F, FName);
  854.   Reset(F);
  855.  
  856.   if IOResult <> 0 then
  857.    Exit;
  858.  
  859.   SetFTime(F, K);
  860.  
  861.   Close(F);
  862.  
  863.   if IOResult <> 0 then;
  864.  end;
  865.  
  866. { Other stuff }
  867.  
  868. function Clock: Longint;
  869. {$IFDEF VIRTUALPASCAL}
  870.  begin
  871.   Clock:=SysSysMsCount;
  872.  end;
  873. {$ELSE}
  874.  assembler;
  875.   asm
  876.              push    ds              { save caller's data segment }
  877.              mov     ds, seg0040     {  access ticker counter }
  878.              mov     bx, 6ch         { offset of ticker counter in segm.}
  879.              mov     dx, 43h         { timer chip control port }
  880.              mov     al, 4           { freeze timer 0 }
  881.              pushf                   { save caller's int flag setting }
  882.              cli                     { make reading counter an atomic operation}
  883.              mov     di, ds:[bx]     { read bios ticker counter }
  884.              mov     cx, ds:[bx+2]
  885.              sti                     { enable update of ticker counter }
  886.              out     dx, al          { latch timer 0 }
  887.              cli                     { make reading counter an atomic operation}
  888.              mov     si, ds:[bx]     { read bios ticker counter }
  889.              mov     bx, ds:[bx+2]
  890.              in      al, 40h         { read latched timer 0 lo-byte }
  891.              mov     ah, al          { save lo-byte }
  892.              in      al, 40h         { read latched timer 0 hi-byte }
  893.              popf                    { restore caller's int flag }
  894.              xchg    al, ah          { correct order of hi and lo }
  895.              cmp     di, si          { ticker counter updated ? }
  896.              je      @no_update      { no }
  897.              or      ax, ax          { update before timer freeze ? }
  898.              jns     @no_update      { no }
  899.              mov     di, si          { use second }
  900.              mov     cx, bx          {  ticker counter }
  901. @no_update:  not     ax              { counter counts down }
  902.              mov     bx, 36edh       { load multiplier }
  903.              mul     bx              { w1 * m }
  904.              mov     si, dx          { save w1 * m (hi) }
  905.              mov     ax, bx          { get m }
  906.              mul     di              { w2 * m }
  907.              xchg    bx, ax          { ax = m, bx = w2 * m (lo) }
  908.              mov     di, dx          { di = w2 * m (hi) }
  909.              add     bx, si          { accumulate }
  910.              adc     di, 0           {  result }
  911.              xor     si, si          { load zero }
  912.              mul     cx              { w3 * m }
  913.              add     ax, di          { accumulate }
  914.              adc     dx, si          {  result in dx:ax:bx }
  915.              mov     dh, dl          { move result }
  916.              mov     dl, ah          {  from dl:ax:bx }
  917.              mov     ah, al          {   to }
  918.              mov     al, bh          {    dx:ax:bh }
  919.              mov     di, dx          { save result }
  920.              mov     cx, ax          {  in di:cx }
  921.              mov     ax, 25110       { calculate correction }
  922.              mul     dx              {  factor }
  923.              sub     cx, dx          { subtract correction }
  924.              sbb     di, si          {  factor }
  925.              xchg    ax, cx          { result back }
  926.              mov     dx, di          {  to dx:ax }
  927.              pop     ds              { restore caller's data segment }
  928.   end;
  929. {$ENDIF}
  930.  
  931. function DayOfWeek(Y, M, D: Word): Word;
  932.  var
  933.   Tmp1, Tmp2, yy, mm, dd: Longint;
  934.  begin
  935.   yy := y;
  936.   mm := m;
  937.   dd := d;
  938.   Tmp1 := mm + 10;
  939.   Tmp2 := yy + (mm - 14) DIV 12;
  940.   DayOfWeek :=  ((13 *  (Tmp1 - Tmp1 DIV 13 * 12) - 1) DIV 5 +
  941.                 dd + 77 + 5 * (Tmp2 - Tmp2 DIV 100 * 100) DIV 4 +
  942.                 Tmp2 DIV 400 - Tmp2 DIV 100 * 2) MOD 7;
  943.  end;
  944.  
  945. function StackOverflow: boolean;
  946.  begin
  947.   StackOverflow:=SPtr < $1000;
  948.  end;
  949.  
  950. function TimeFix: Longint;
  951.  var
  952.   DT: DateTime;
  953.   L: Longint;
  954.   Hour, Min, Sec, Day, Month, Year: Word;
  955.  begin
  956.   IWannaTime(Hour, Min, Sec);
  957.   IWannaDate(Day, Month, Year);
  958.   DT.Hour:=Hour;
  959.   DT.Min:=Min;
  960.   DT.Sec:=Sec;
  961.   DT.Day:=Day;
  962.   DT.Month:=Month;
  963.   DT.Year:=Year;
  964.   PackTime(DT, L);
  965.   TimeFix:=L;
  966.  end;
  967.  
  968. function _Date(L: Longint): String;
  969. (*{$IFDEF VIRTUALPASCAL}
  970.  begin
  971.   _Date:=DateTimeToStr(L);
  972.  end;
  973. {$ELSE}*)
  974.  var
  975.   DT: DateTime;
  976.  begin
  977.   UnpackTime(L,DT);
  978.  
  979.   _Date:=LeftPadCh(Long2Str(DT.Day),'0',2) + '.' +  LeftPadCh(Long2Str(DT.Month),'0',2) + '.' + Long2Str(DT.Year);
  980.  end;
  981. (*{$ENDIF}*)
  982.  
  983. function _Time(L: Longint): String;
  984. (*{$IFDEF VIRTUALPASCAL}
  985.  begin
  986.   _Time:=DateTimeToStr(L);
  987.  end;
  988. {$ELSE}*)
  989.  var
  990.   DT: DateTime;
  991.  begin
  992.    UnpackTime(L,DT);
  993.   _Time:=LeftPadCh(Long2Str(DT.Hour),'0',2)+':'+LeftPadCh(Long2Str(DT.Min),'0',2);
  994.  end;
  995. (*{$ENDIF}*)
  996.  
  997. procedure IWannaDate(var D, M, Y: Word);
  998.  var
  999.   aY, aM, aD, aT: xWord;
  1000.  begin
  1001.   GetDate(aY, aM, aD, aT);
  1002.  
  1003.   D:=aD;
  1004.  
  1005.   M:=aM;
  1006.  
  1007.   Y:=aY;
  1008.  end;
  1009.  
  1010. procedure IWannaTime(var H, M, S: Word);
  1011.  var
  1012.   aH, aM, _aS, _aT: xWord;
  1013.  begin
  1014.   GetTime(aH, aM, _aS, _aT);
  1015.  
  1016.   H:=aH;
  1017.  
  1018.   M:=aM;
  1019.  
  1020.   S:=_aS;
  1021.  end;
  1022.  
  1023. procedure TimeDif(L: Longint; var DT: DateTime);
  1024.  begin
  1025.   UnpackTime(L, DT);
  1026.   with DT do
  1027.    if Year >= 1980 then Dec(Year, 1980);
  1028.  end;
  1029.  
  1030. procedure Wait(const ms: Longint);
  1031.  {$IFDEF VIRTUALPASCAL}
  1032.  begin
  1033.   SysCtrlSleep(ms);
  1034.  end;
  1035.  {$ELSE}
  1036.  var
  1037.   Anchor: Longint;
  1038.  begin
  1039.   Anchor:=Clock;
  1040.  
  1041.   repeat until (Clock - Anchor > ms) or (Clock - Anchor < 0);
  1042.  end;
  1043.  {$ENDIF}
  1044.  
  1045. { FidoNet stuff :-) }
  1046.  
  1047. function GetPktDateTime: String;
  1048.  var
  1049.   Day, Month, Year, Hour, Min, Sec: Word;
  1050.  begin
  1051.   iWannaTime(Hour, Min, Sec);
  1052.   iWannaDate(Day, Month, Year);
  1053.   GetPktDateTime:=LeftPadCh(Long2Str(Day),'0',2)+' '+Copy(Months[Month],1,3)+' '+Copy(Long2Str(Year),3,2)+'  '+
  1054.      LeftPadCh(Long2Str(Hour),'0',2)+':'+LeftPadCh(Long2Str(Min),'0',2)+':'+LeftPadCh(Long2Str(Sec),'0',2);
  1055.  end;
  1056.  
  1057. function GetPktDateTimeCustom(Day, Month, Year, Hour, Min, Sec: Word): String;
  1058.  begin
  1059.   GetPktDateTimeCustom:=LeftPadCh(Long2Str(Day),'0',2)+' '+Copy(Months[Month],1,3)+' '+Copy(Long2Str(Year),3,2)+'  '+
  1060.      LeftPadCh(Long2Str(Hour),'0',2)+':'+LeftPadCh(Long2Str(Min),'0',2)+':'+LeftPadCh(Long2Str(Sec),'0',2);
  1061.  end;
  1062.  
  1063. procedure ParsePktDateTime(S: String; var Day, Month, Year, Hour, Min, Sec, Dow: XWord);
  1064.  const
  1065.   MonthsU: array[1..12] of String[3] = ('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC');
  1066.  var
  1067.   K: Byte;
  1068.  begin
  1069.   StUpcaseEx(S);
  1070.   Str2XWord(ExtractWord(1, S, [' ',':']), Day);
  1071.   Month:=0;
  1072.   for K:=1 to 12 do
  1073.    if Copy(S, 4, 3) = MonthsU[K] then Month:=K;
  1074.   Str2XWord(ExtractWord(3, S, [' ',':']), Year);
  1075.   if Year<81 then Inc(Year, 2000) else Inc(Year, 1900);
  1076.   Str2XWord(ExtractWord(4, S, [' ',':']), Hour);
  1077.   Str2XWord(ExtractWord(5, S, [' ',':']), Min);
  1078.   Str2XWord(ExtractWord(6, S, [' ',':']), Sec);
  1079.   Dow:=DayOfWeek(Year, Month, Day);
  1080.  end;
  1081.  
  1082. { Multiplatform stuff }
  1083.  
  1084. {$IFDEF DOS}
  1085. procedure FindClose(var SR: SearchRec);
  1086.  begin
  1087.  end;
  1088. {$ENDIF}
  1089.  
  1090. { Added in 2.01 }
  1091.  
  1092. {$IFNDEF VIRTUALPASCAL}
  1093. { The following part of code has been cut from
  1094.   Turbo Professional 5.21 (c) by TurboPower Software, 1987, 1992. }
  1095.  
  1096. function TextSeek(var F: Text; Target: LongInt): Boolean;
  1097.  var
  1098.   T: Long absolute Target;
  1099.   Pos: LongInt;
  1100.   Regs: Registers;
  1101.  begin
  1102.   TextSeek:=False;
  1103.   with Regs, TText(F) do
  1104.    begin
  1105.     if Mode <> FMInput then Exit;
  1106.     AX:=$4201;
  1107.     BX:=Handle;
  1108.     CX:=0;
  1109.     DX:=0;
  1110.     MsDos(Regs);
  1111.     if Odd(Flags) then Exit;
  1112.     Long(Pos).HighWord := DX;
  1113.     Long(Pos).LowWord := AX;
  1114.     Dec(Pos, BufEnd);
  1115.     Pos:=Target - Pos;
  1116.     if (Pos >= 0) and (Pos < BufEnd) then
  1117.      BufPos:=Pos
  1118.     else
  1119.      begin
  1120.       AX:=$4200;
  1121.       BX:=Handle;
  1122.       CX:=T.HighWord;
  1123.       DX:=T.LowWord;
  1124.       MsDos(Regs);
  1125.       if Odd(Flags) then Exit;
  1126.       BufEnd := 0;
  1127.       BufPos := 0;
  1128.      end;
  1129.    end;
  1130.   TextSeek:=True;
  1131.  end;
  1132.  
  1133. function TextFileSize(var F: Text) : LongInt;
  1134.  var
  1135.   OldHi, OldLow: Integer;
  1136.   Regs: Registers;
  1137.  begin
  1138.   with Regs, TText(F) do
  1139.    begin
  1140.     if Mode = FMClosed then
  1141.      begin
  1142.       TextFileSize:=-1;
  1143.       Exit;
  1144.      end;
  1145.     AX:=$4201;
  1146.     BX:=Handle;
  1147.     CX:=0;
  1148.     DX:=0;
  1149.     MsDos(Regs);
  1150.     if Odd(Flags) then
  1151.      begin
  1152.       TextFileSize := -1;
  1153.       Exit;
  1154.      end;
  1155.     OldHi:=DX;
  1156.     OldLow:=AX;
  1157.     AX:=$4202;
  1158.     BX:=Handle;
  1159.     CX:=0;
  1160.     DX:=0;
  1161.     MsDos(Regs);
  1162.     if Odd(Flags) then
  1163.      begin
  1164.       TextFileSize := -1;
  1165.       Exit;
  1166.      end;
  1167.     TextFileSize:=LongInt(DX) shl 16 + AX;
  1168.     AX:=$4200;
  1169.     BX:=Handle;
  1170.     CX:=OldHi;
  1171.     DX:=OldLow;
  1172.     MsDos(Regs);
  1173.     if Odd(Flags) then
  1174.      TextFileSize:=-1;
  1175.    end;
  1176.  end;
  1177.  
  1178. function TextPos(var F: Text): LongInt;
  1179.  var
  1180.   Position: LongInt;
  1181.   Regs: Registers;
  1182.  begin
  1183.   with Regs, TText(F) do
  1184.    begin
  1185.     if Mode = FMClosed then
  1186.      begin
  1187.       TextPos := -1;
  1188.       Exit;
  1189.      end;
  1190.     AX:=$4201;
  1191.     BX:=Handle;
  1192.     CX:=0;
  1193.     DX:=0;
  1194.     MsDos(Regs);
  1195.     if Odd(Flags) then
  1196.      begin
  1197.       TextPos:=-1;
  1198.       Exit;
  1199.      end;
  1200.     Long(Position).HighWord := DX;
  1201.     Long(Position).LowWord := AX;
  1202.     if Mode = FMOutput then
  1203.      Inc(Position, BufPos)
  1204.     else
  1205.      if BufEnd <> 0 then
  1206.       Dec(Position, BufEnd - BufPos);
  1207.     TextPos:=Position;
  1208.    end;
  1209.  end;
  1210. {$ENDIF}
  1211.  
  1212. {$IFDEF VIRTUALPASCAL}
  1213. function TextSeek(var F: Text; Target: LongInt): Boolean;
  1214.  var
  1215.   P: LongInt;
  1216.   T: TextRec absolute F;
  1217.  begin
  1218.   TextSeek:=True;
  1219.  
  1220.   SysFileSeek(T.Handle, 0, 1, P);
  1221.  
  1222.   Dec(P, T.BufEnd);
  1223.  
  1224.   P:=Target - P;
  1225.  
  1226.   if (P >= 0) and (P < T.BufEnd) then
  1227.    T.BufPos:=P
  1228.   else
  1229.    begin
  1230.     SysFileSeek(T.Handle, Target, 0, P);
  1231.  
  1232.     T.BufEnd:=0;
  1233.     T.BufPos:=0;
  1234.    end;
  1235.  end;
  1236.  
  1237. function TextFileSize(var F: Text): LongInt;
  1238.  var
  1239.   T: TextRec absolute F;
  1240.   P: Longint;
  1241.  begin
  1242.   SysFileSeek(T.Handle, 0, 1, P);
  1243.  
  1244.   SysFileSeek(T.Handle, 0, 2, Result);
  1245.  
  1246.   SysFileSeek(T.Handle, P, 0, P);
  1247.  end;
  1248.  
  1249. function TextPos(var F: Text): LongInt;
  1250.  var
  1251.   T: TextRec absolute F;
  1252.  begin
  1253.   SysFileSeek(T.Handle, 0, 1, Result);
  1254.  
  1255.   if T.Mode = fmOutput then
  1256.    Inc(Result, T.BufPos)
  1257.   else
  1258.    if T.BufEnd <> 0 then
  1259.     Dec(Result, T.BufEnd - T.BufPos);
  1260.  end;
  1261. {$ENDIF}
  1262.  
  1263. { Added in 2.02 }
  1264.  
  1265. const
  1266.  ItsFirst: Integer = 0;
  1267.  
  1268. function CheckWildcard(S, Mask: String): Boolean;
  1269.  var
  1270.   I: integer;
  1271.   J: integer;
  1272.   Ok: boolean;
  1273.   St: string;
  1274.   Msk: string;
  1275.  begin
  1276.   if (Pos('?', Mask) = 0) and (Pos('*', Mask) = 0) then
  1277.    begin
  1278.     CheckWildcard:=S = Mask;
  1279.     Exit;
  1280.    end;
  1281.   Inc(ItsFirst);
  1282.   I:=1;
  1283.   if ItsFirst=1 then
  1284.    begin
  1285.     while True do
  1286.      begin
  1287.       J:=Length(Mask);
  1288.       while I<Length(Mask) do
  1289.        begin
  1290.         if (Mask[I]='?') And (Mask[I+1]='*') Then Delete(Mask,I,1);
  1291.         if (Mask[I]='*') And (Mask[I+1]='?') And (I<Length(Mask)) Then Delete(Mask,I+1,1);
  1292.         If (Mask[I]='*') And (Mask[I+1]='*') And (I<Length(Mask)) Then Delete(Mask,I,1);
  1293.         Inc(I);
  1294.        end;
  1295.       if J=Length(Mask) then Break;
  1296.       I:=1;
  1297.      end;
  1298.    end;
  1299.   Ok:=True;
  1300.   I:=1;
  1301.   J:=1;
  1302.   while True do
  1303.    begin
  1304.     case Mask[I] Of
  1305.     '*':
  1306.       Begin
  1307.         Msk:=Copy(Mask,I+1,Length(Mask)-I+1);
  1308.         St:=Copy(S,J,Length(S)-J+1);
  1309.         while (St<>'') and (not CheckWildcard(St,Msk)) do Delete(St,1,1);
  1310.         If (St='') and (Msk<>'') then Ok:=False else J:=Pos(St,S);
  1311.       End;
  1312.     '?':
  1313.       Begin
  1314.         If (I=Length(Mask)) And (J<Length(S)) Then Ok:=False;
  1315.         If J>Length(S) Then Ok:=False;
  1316.         Inc(J);
  1317.       End;
  1318.     else
  1319.      if Mask[I]<>S[J] then Ok:=False else Inc(J);
  1320.     end;
  1321.     if J-1>Length(S) then Ok:=False;
  1322.     if not Ok then Break;
  1323.     Inc(I);
  1324.     if I>Length(Mask) then Break;
  1325.    end;
  1326.   CheckWildcard:=Ok;
  1327.   Dec(ItsFirst);
  1328.  end;
  1329.  
  1330. { Added in 2.04 }
  1331. function GetBinkDateTime: String;
  1332.  var
  1333.   Year, Month, Day, Hour, Min, Sec: Word;
  1334.  begin
  1335.   IWannaDate(Day, Month, Year);
  1336.   IWannaTime(Hour, Min, Sec);
  1337.   GetBinkDateTime:=LeftPadCh(Long2Str(Day), '0', 2) + ' ' + Months[Month] + ' ' +
  1338.    LeftPadCh(Long2Str(Hour), '0', 2) + ':' + LeftPadCh(Long2Str(Min), '0', 2) + ':' +
  1339.    LeftPadCh(Long2Str(Sec), '0', 2);
  1340.  end;
  1341.  
  1342. { Added in 2.05 }
  1343.  
  1344. function MakeFmt(const R: String): String;
  1345.  var
  1346.   K, L: Byte;
  1347.   S: String;
  1348.   Minus: Boolean;
  1349.  begin
  1350.   S:='';
  1351.   L:=0;
  1352.   for K:=Length(R) downto 1 do
  1353.    begin
  1354.     S:=R[K] + S;
  1355.     Inc(L);
  1356.     if L=3 then
  1357.      begin
  1358.       S:=','+S;
  1359.       L:=0;
  1360.      end;
  1361.    end;
  1362.   Minus:=Copy(S, 1, 1)='-';
  1363.   if Minus then Delete(S, 1, 1);
  1364.   while Copy(S,1,1)=',' do Delete(S,1,1);
  1365.   if Minus then S:='-'+S;
  1366.   MakeFmt:=S;
  1367.  end;
  1368.  
  1369. { Added in 2.07 }
  1370.  
  1371. procedure GrowDateBackward(var Date: Longint);
  1372.  var
  1373.   DT: DateTime;
  1374.  begin
  1375.   UnpackTime(Date, DT);
  1376.  
  1377.   Dec(DT.Day);
  1378.  
  1379.   if DT.Day < 1 then
  1380.    begin
  1381.     Dec(DT.Month);
  1382.  
  1383.     if DT.Month < 1 then
  1384.      begin
  1385.       DT.Month:=12;
  1386.  
  1387.       Dec(DT.Year);
  1388.      end;
  1389.  
  1390.     DT.Day:=Days[DT.Year mod 4 = 0, DT.Month];
  1391.    end;
  1392.  
  1393.   PackTime(DT, Date);
  1394.  end;
  1395.  
  1396. procedure GrowDateForward(var Date: Longint);
  1397.  var
  1398.   DT: DateTime;
  1399.  begin
  1400.   UnpackTime(Date, DT);
  1401.  
  1402.   Inc(DT.Day);
  1403.  
  1404.   if DT.Day > Days[DT.Year mod 4 = 0, DT.Month] then
  1405.    begin
  1406.     DT.Day:=1;
  1407.  
  1408.     Inc(DT.Month);
  1409.  
  1410.     if DT.Month > 12 then
  1411.      begin
  1412.       DT.Month:=1;
  1413.  
  1414.       Inc(DT.Year);
  1415.      end;
  1416.    end;
  1417.  
  1418.   PackTime(DT, Date);
  1419.  end;
  1420.  
  1421. procedure GrowDate(var Date: Longint; const Delta: Longint);
  1422.  var
  1423.   K: Longint;
  1424.  begin
  1425.   if Delta < 0 then
  1426.    for K:=Delta to -1 do
  1427.     GrowDateBackward(Date)
  1428.   else
  1429.    if Delta > 0 then
  1430.     for K:=1 to Delta do
  1431.      GrowDateForward(Date);
  1432.  end;
  1433.  
  1434. { Added in 2.08 }
  1435.  
  1436. function JustFilenameOnly(const PathName: String): String;
  1437.  var
  1438.   I: Integer;
  1439.   S: String;
  1440.  begin
  1441.   S:=JustFilename(PathName);
  1442.  
  1443.   I:=Length(S);
  1444.  
  1445.   while (I <> 0) and (S[I] <> '.') do
  1446.    Dec(I);
  1447.  
  1448.   if I <= 1 then
  1449.    JustFileNameOnly:=''
  1450.   else
  1451.    JustFilenameOnly:=Copy(S, 1, I - 1);;
  1452.  end;
  1453.  
  1454. { Added in 2.09 }
  1455.  
  1456. procedure ClrIO;
  1457.  begin
  1458.   InOutRes:=0;
  1459.   DosError:=0;
  1460.  end;
  1461.  
  1462. function __IOcheck: Boolean;
  1463.  begin
  1464.   __IOcheck:=InOutRes <> 0;
  1465.  end;
  1466.  
  1467. function __IOerror: String;
  1468.  begin
  1469.   __IOerror:='rc=#' + HexL(InOutRes);
  1470.  end;
  1471.  
  1472. procedure __IOclear;
  1473.  begin
  1474.   InOutRes:=0;
  1475.  end;
  1476.  
  1477. { Added in 2.10 }
  1478.  
  1479. function EraseFile(const FName: String): Boolean;
  1480.  var
  1481.   F: Text;
  1482.  begin
  1483.   if IOResult <> 0 then;
  1484.  
  1485.   Assign(F, FName);
  1486.   Erase(F);
  1487.  
  1488.   EraseFile:=IOResult = 0;
  1489.  end;
  1490.  
  1491. { Added in 2.11 }
  1492.  
  1493. function ToJulian(_Day, _Month, _Year: Longint): LongInt;
  1494.  var
  1495.   Century, XYear, Temp, Month: LongInt;
  1496.  begin
  1497.   Month:=_Month;
  1498.  
  1499.   if Month <= 2 then
  1500.    begin
  1501.     Dec(_Year);
  1502.     Inc(Month, 12);
  1503.    end;
  1504.  
  1505.   Dec(Month, 3);
  1506.   Century:=_Year Div 100;
  1507.   XYear:=_Year Mod 100;
  1508.   Century:=(Century * D1) shr 2;
  1509.   XYear:=(XYear * D0) shr 2;
  1510.   ToJulian:=((((Month * 153) + 2) div 5) + _Day) + D2 + XYear + Century;
  1511.  end;
  1512.  
  1513. procedure FromJulian(JulianDN: LongInt; var Year, Month, Day: Longint);
  1514.  var
  1515.   Temp, XYear: LongInt;
  1516.   YYear, YMonth, YDay: Integer;
  1517.  begin
  1518.   Temp:=(((JulianDN - D2) shl 2) - 1);
  1519.   XYear:=(Temp mod D1) or 3;
  1520.   JulianDN:=Temp div D1;
  1521.   YYear:=(XYear div D0);
  1522.   Temp:=((((XYear mod D0) + 4) shr 2) * 5) - 3;
  1523.   YMonth:=Temp div 153;
  1524.   if YMonth >= 10 then
  1525.    begin
  1526.     YYear:=YYear + 1;
  1527.     YMonth:=YMonth - 12;
  1528.    end;
  1529.   YMonth:=YMonth + 3;
  1530.   YDay:=Temp mod 153;
  1531.   YDay:=(YDay + 5) div 5;
  1532.   Year:=YYear + (JulianDN * 100);
  1533.   Month:=YMonth;
  1534.   Day:=YDay;
  1535.  end;
  1536.  
  1537. function GetCurrentJulian: Longint;
  1538.  var
  1539.   Day, Month, Year: Word;
  1540.  begin
  1541.   IWannaDate(Day, Month, Year);
  1542.  
  1543.   GetCurrentJulian:=ToJulian(Day, Month, Year);
  1544.  end;
  1545.  
  1546. procedure FixTabs(var S: String);
  1547.  var
  1548.   O: String;
  1549.   K, L, M: Byte;
  1550.  begin
  1551.   if Pos(#9, S) = 0 then
  1552.    Exit;
  1553.  
  1554.   O:=S;
  1555.  
  1556.   S:='';
  1557.  
  1558.   M:=0;
  1559.  
  1560.   for K:=1 to Length(O) do
  1561.    case O[K] of
  1562.     #9:
  1563.      begin
  1564.       L:=8 - (M and 7);
  1565.  
  1566.       Inc(M, L);
  1567.  
  1568.       while L <> 0 do
  1569.        begin
  1570.         S:=Concat(S, ' ');
  1571.  
  1572.         Dec(L);
  1573.        end;
  1574.      end;
  1575.    else
  1576.     S:=Concat(S, O[K]);
  1577.  
  1578.     Inc(M);
  1579.    end;
  1580.  end;
  1581.  
  1582. end.