{$IFDEF MSDOS}
{$S-,R-,V-,O+,A-,P-,T-,X-,Q-,F+}
{$ENDIF}
{$I-,B-}

{*********************************************************}
{*                       TMISC.PAS                       *}
{*     Copyright (c) TurboPower Software 1987, 1992.     *}
{*     Copyright (c) Konstantin Klyagin 1996.            *}
{*                 All rights reserved.                  *}
{*********************************************************}

Unit tMisc;
  {-Basic string manipulation routines}

Interface

Uses
{$IFNDEF WIN32}
  DOS,
  ApSame,
{$ELSE}
  SysUtils,
  Windows,
{$ENDIF}
{$IFDEF OS2}
  Os2Base,
{$ENDIF}
  Crc32,
  OpCrt;

Const
  ExtLen = 3;
  DefaultDateMask = 'MM-DD-YYYY';

Type
  DayType = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);

  AddrType = Record
    Zone, Net, Node, Point      : Word;
  End;

Type
  SysInt = {$IFDEF MSDOS} Word {$ENDIF}
           {$IFDEF OS2} LongInt {$ENDIF}
           {$IFDEF WIN32} Integer {$ENDIF};

Const
  sDOW: Array [DayType] Of String [9] =
    ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday',
      'Friday', 'Saturday');

  sMonths : Array [1..12] Of String [3] =
    ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug',
     'Sep', 'Oct', 'Nov', 'Dec');

  MaxTime = 1439;        {= 23:59 }
  BadTime = $FFFF;
  MinInHour = 60;        {минут в часу}
  Threshold2000 : Integer = 1900;
  MinYear  = 1600;
  First2Months = 59;
  HoursInDay = 24;
  SecondsInHour = 3600;
  SecondsInMinute = 60;
  SecondsInDay = 86400;

Type
  tTime = Word;

  tTimePeriod = Record
                  rtBegin,               {начало и}
                  rtEnd         : tTime; {конец действия пpавила}
                  rDOW          : Byte;   {
                  пеpвый и последний день действия пpавила -
                  мл. 4 бита от rDOW : day begin
                  ст. 4 бита от rDOW : day end }
                End;

  TimeArray = Record
                nTPer   : Byte;
                TPer    : Array [1..7] Of tTimePeriod;
              End;

Type
  CharSet = Set Of Char;
  CompareType = (Less, Equal, Greater);
  BTable = Array [0..255] Of Byte; {For Boyer-Moore searching}

{$IFNDEF OS2}
{$IFOPT N+}
  Float = Extended;
{$ELSE}
  Float = Real;
{$ENDIF}
{$ELSE}
  Float = Real;
{$ENDIF}

  YesNoAuto   = (ynYes, ynNo, ynAuto);
  AskType     = (atAsk, atYes, atNo);
  LayerType   = (Fossil, Uart, Digi14, Int14);
  tAbortKey   = (akAny, akEsc, akNone);

{$I INC\config.inc}

Const
  MoneySign      : Char = '$';       {Used by Form for floating dollar sign}
  CommaForPeriod : Boolean = False;  {replace '.' with ',' in Form masks}

Function LoCaseMac (CH : Char) : Char;
  {-Lowercase character macro, no international character support}
{$IFDEF MSDOS}
  Inline (
    $58 /                     {POP  AX}
    $3C / $41 /                 {CMP    AL,'A'}
    $72 / $06 /                 {JB     No}
    $3C / $5A /                 {CMP    AL,'Z'}
    $77 / $02 /                 {JA     No}
    $0C / $20);                {OR     AL,$20}
{$ENDIF}

Function UpCase (C: Char): Char;
Function LoCase (C: Char): Char;

Function UpString (par: String): String;
Function LoString (par: String): String;
Function PrString (St: String): String;

  {-------- Numeric conversion -----------}

Function HexB (B : Byte) : String;
  {-Return hex string for byte}

Function HexW (W : Word) : String;
  {-Return hex string for word}

Function HexL (L : LongInt) : String;
  {-Return hex string for longint}

Function Str2Word (S : String; Var I : Word) : Boolean;
  {-Convert a string to a word, returning true if successful}

Function Long2Str (L : LongInt) : String;
  {-Convert a longint/word/integer/byte/shortint to a string}

Function Real2Str (R : Float; Width : Byte; Places : ShortInt) : String;
  {-Convert a real to a string}

Function HexOne (H: Char): Byte;
{-пеpеводит символ ('0'..'9','A'..'F') в его полу-байтовый эквивалент}

Function Hex2Byte (S: String): Byte;
{-стpоку HEX -> в байт}

Function Hex2Word (S: String): Word;
{-стpоку HEX -> в слово}

Function Hex2Long (S: String): LongInt;

  {-------- General purpose string manipulation --------}

Procedure Pause (Duration: LongInt);
Function DelChars (Ch: CharSet; S: String): String;
Function StrPosition (SubStr, Str: String; FromPos: Byte): Byte;
Function RPos (SubStr, Str: String; StartPos: Byte): Byte;

Function PadCh (S : String; CH : Char; Len : Byte) : String;
  {-Return a string right-padded to length len with ch}

Function Pad (S : String; Len : Byte) : String;
  {-Return a string right-padded to length len with blanks}

Function LeftPadCh (S : String; CH : Char; Len : Byte) : String;
  {-Return a string left-padded to length len with ch}

Function LeftPad (S : String; Len : Byte) : String;
  {-Return a string left-padded to length len with blanks}

Function TrimLead (S : String) : String;
  {-Return a string with leading white space removed}

Function TrimTrail (S : String) : String;
  {-Return a string with trailing white space removed}

Function Trim (S : String) : String;
  {-Return a string with leading and trailing white space removed}

Function TrimSpaces (S : String) : String;
  {-Return a string with leading and trailing spaces removed}

Function CenterCh (S : String; CH : Char; Width : Byte) : String;
  {-Return a string centered in a string of Ch with specified width}

  {--------------- Word manipulation -------------------------------}

Function WordCount (S : String; WordDelims : CharSet) : Byte;
  {-Given a set of word delimiters, return number of words in S}

Function SymbolCount (S : String; Symbol : Char) : Byte;
  {-Return number of symbols in S}

Function WordPosition (N : Byte; S : String; WordDelims : CharSet) : Byte;
  {-Given a set of word delimiters, return start position of N'th word in S}

Function AsciiCount (S : String; WordDelims : CharSet; Quote : Char) : Byte;
  {!!.13-Given a set of word delimiters, return number of words in S}

Function AsciiPosition (N : Byte; S : String; WordDelims : CharSet; Quote : Char) : Byte;
  {!!.13-Given a set of word delimiters, return start position of N'th word in S}

Function ExtractAscii (N : Byte; S : String; WordDelims : CharSet; Quote : Char) : String;
  {!!.13-Given a set of word delimiters, return the N'th word in S}

Procedure WordWrap (InSt : String; Var OutSt, Overlap : String;
                   Margin : Byte; PadToMargin : Boolean);
 {-Wrap InSt at Margin, storing the result in OutSt and the remainder in
   Overlap}

  {--------------- DOS pathname parsing -----------------}

Function ForceExtension (Name : String; Ext : ExtStr) : String;
  {-Force the specified extension onto the file name}

Function JustFilename (PathName : String) : String;
  {-Return just the filename and extension of a pathname}

Function JustName (PathName : String) : String;
  {-Return just the name (no extension, no path) of a pathname}

Function JustExtension (Name : String) : ExtStr;
  {-Return just the extension of a pathname}

Function JustPathname (PathName : String) : String;
  {-Return just the drive:directory portion of a pathname}

Function AddBackSlash (DirName : String) : String;
  {-Add a default backslash to a directory name}

Function CleanPathName (PathName : String) : String;
  {-Return a pathname cleaned up as DOS will do it}

Function FullPathName (FName : String) : String;
  {-Given FName (known to exist), return a full pathname}
  {the following procedures are for internal use only}

Function ConsistsOf (S: String; Symbols: CharSet): Boolean;
Function StrContains (S: String; Symbols: CharSet): Boolean;

Function DelSpaces (S: String): String;
Function NiceFileName (FName: String; Len: Byte) : String;
Function AsciiCode2Str (S: String): String;

Function ExtractWord (N : Byte; S : String; WordDelims : CharSet) : String;
  {-Given a set of word delimiters, return the N'th word in S}

Function RelativeAddr (S: String; Addr: AddrType): String;
Function CommaStr (Number: LongInt): String;
Function InRange (Num: LongInt; Range: String): Boolean;

Function DateStr (DosDate: LongInt): String;
Function TimeStr (DosDate: LongInt): String;

Function FormattedDate (DT: {$IFNDEF WIN32} DOS. {$ENDIF} DateTime; Mask: String): String;
Function PlaceSubStr (InSt, WhatSt, ToSt : String): String;

Function ReformatDate (ODate: String; InMask, Mask: String): String;
Function TimeStr2Word (TS: String): Word;
Function Word2TimeStr (CTime: Word): String;
Function Az2Str (Str: String; MaxLen: Byte): String; {Convert asciiz to string}
Procedure Str2Az (Str: String; MaxLen: Byte; Var AZStr); {Convert string to asciiz}

Function IsNumeric (Str: String): Boolean;
Function PosLastChar (CH: Char; St: String): Word;

Function Replicate (c: Char; n: Integer): String;
Function Date2Long (Date: String) : LongInt;
Function Long2Date (Julian : LongInt): String;

Function Word2Time (W: Word): String;
Function Time2Word (S: String): Word;
Function PackStrTime (Date, Mask: String): LongInt;

Function Time2Long (Time: String): LongInt;
Function Str2Long (St: String): LongInt;
Function PhoneValid (S: String): Boolean;
Function SplitString (Var S: String; Len: Byte): String;
Function CharTrans (S, Source, Dest: String): String;

Function DateMaskMatch (Date, Mask: String): Boolean;
Procedure UnixDate2DateTime (UnixDate: LongInt; Var DT: {$IFNDEF WIN32} DOS. {$ENDIF} DateTime);
Function DateTime2UnixDate (DT : {$IFNDEF WIN32} DOS. {$ENDIF} DateTime) : LongInt;
Function DateMatch (Date, Mask: String): Boolean;
Function ExtractDate (sDate, DateMask: String; Var Year, Month, Day: Word): Boolean;
Function GetLiterals (Str: String; Var Ps1, Ps2: Byte): String;

Function FileExists (Name: String): Boolean;
Function DirExists (Dir: String): Boolean;
Function FileDate (Name: String): LongInt;
Function gFileSize (Name: String): LongInt;
Function gFileAttr (Name: String): Byte;
Function CompletePath (Path : PathStr): PathStr;
Function DefaultName (F, Ext, Dir: PathStr): String;
{$IFNDEF WIN32}
Procedure SetLength (Var S: String; Len: Byte);
{$ENDIF}

Function StrDate: String;
Function StrTime: String;
Procedure SoundOf (S: String);
Function MidSec : LongInt;
Function HowTime (Sec: LongInt): String;
Function CompareDates (S1, S2: String): Byte;
Function DateL: LongInt;
Function Crc32Str (S: String): LongInt;
function DMYtoDate (Day, Month, Year : Integer) : LongInt;
function HMStoTime (Hours, Minutes, Seconds : Byte) : LongInt;
Function HoursDiff (DT1, DT2 : {$IFNDEF WIN32} DOS. {$ENDIF} DateTime): LongInt;
Procedure SmartChDir (S: PathStr);

Function ToUnixDate (FDate: LongInt): LongInt;
Function GetUnixDate: LongInt;
Function FromUnixDate (UnixDate: LongInt): {$IFNDEF WIN32} LongInt
                                           {$ELSE} TDateTime {$ENDIF};
Function UnixDate2Time (UnixDate: LongInt): String;
Function UnixDate2Date (UnixDate: LongInt): String;
Procedure GetDateTime (Var cDT: {$IFNDEF WIN32} DOS. {$ENDIF} DateTime);

Function Hi4 (b: Byte): Byte;
Function Lo4 (b: Byte): Byte;
Function Color2Byte (Color: String): Byte;
Function MonthStr (Num: Byte): String;
Function NiceFileSize (Size: LongInt): String;
Function MatchWildCard (S1, Mask: PathStr): Boolean;
Function MatchMultiCard (S1, Mask: PathStr): Boolean;
Function MultiFileExists (Path, FileName: PathStr): Boolean;
Function arMatch (B: Array Of Byte; Arr: Array Of Byte): LongInt;
Function arPos (B: Array Of Byte; C: Array Of Byte): LongInt;
Function EstimatedTransferTime (Size, CPS, Speed: LongInt): LongInt;
Function AddressMatch (Addr, Mask: String): Boolean;
Function ValidDate (DT: {$IFNDEF WIN32} DOS. {$ENDIF} DateTime): Boolean;

Function YNA2Bool (YNA: AskType): Boolean;
Function YesNo (S: String): Boolean;
Function YesNoDetect (S: String): YesNoAuto;
Function YNAsk (S: String): AskType;
Function YesNoHidden (S: String): tShowSecured;
Function AnyEscNone (S: String): tAbortKey;
Function AddPath (FileName: PathStr): PathStr;

Function tRenameFile (SourceFile, TargetFile: String): Boolean;
Function tCopyFile (SourceFile, TargetFile: String; OverWrite: Boolean): Boolean;
Function tDeleteFile (FileName: String): Boolean;

{$IFDEF MSDOS}
Procedure Sleep (Tic: Longint);
{$ENDIF}

{$IFDEF WIN32}
Function Str2Win (S: String): String;
{$ENDIF}

(*
Procedure InitTextSeek (Var T: Text; Var F: File);
Procedure TextSeek (Var T: Text; Var F: File; N: LongInt);
*)

Function FlagsValid (UserFlags, NeedFlags: String): Boolean;
Function To4D (S: String): String;
Procedure ParseStrAddr (StrAddr: String; Var Result: AddrType);
Function Addr2Str (Addr: AddrType): String;

Function IsDevice (DevName: String): Boolean;

Procedure Str2Security (S: String; Var Security: Word; Var Flags: String);
Function WordInString (Word, S: String): Boolean;
Procedure ChangeParam (Var Str: String; NewValue: String);
Function TempFName: String;

(* DateTime by Anton the Deinow *)

Function Time2Str (T: tTime): String;
  {-из tTime в стpоку `HH:MM'}

Function Str2Time (s: String): tTime;
  {-пеpевод из стpоки в tTime}

Function Str2timePeriod (s: String; Var TPer: tTimePeriod): Boolean;
  {-конвеpтиpуем из стpоки в стpуктуpу timePeriod или пpосто в time}

Function TimePeriod2Str (TPer: tTimePeriod): String;
  {-из пеpиода в стpоку}

Function MatchTimePeriod (TPer: tTimePeriod): Boolean;
  {-подходит ли тек. вpемя к заданому в TPer}

Function MatchTimeArray (Var TA: TimeArray): Boolean;
  {-сканит массив пеpиодов pаботы TA.TPer и возвpащает:
   TRUE==тек.вpемя/день входит в один из пеpиодов }

Function Str2timeArray (s: String; Var TA: TimeArray): Boolean;
  {-интеpвалы вpемений, pазделенные `,' из стpоки S в TA}

Procedure OpenPageFile (FN: PathStr);
Procedure PlayNextString;
Procedure ClosePageFile;

Const
  CommaChar: Char = ',';

Var
  ExtraString: String;

Implementation

{$IFNDEF WIN32}
Uses
  OpInline;
{$ENDIF}

Type
  OS = Record
         O, S        : Word;
       End;

  Long = Record
           LowWord, HighWord : Word;
         End;

Const
  Digits : Array [0..$F] Of Char = '0123456789ABCDEF';
  DosDelimSet : Set Of Char = ['\', ':', #0];

Const
  C1970 = 2440588;
  D0    =    1461;
  D1    =  146097;
  D2    = 1721119;

Function HexB (B : Byte) : String;
  {-Return hex string for byte}
Begin
  HexB := Digits [B ShR 4] + Digits [B And $F];
End;

Function HexW (W : Word) : String;
  {-Return hex string for word}
Begin
  HexW := Digits [Hi (W) ShR 4] +
          Digits [Hi (W) And $F] +
          Digits [Lo (W) ShR 4] +
          Digits [Lo (W) And $F];
End;

Function HexL (L : LongInt) : String;
  {-Return hex string for LongInt}
Begin
  With Long (L) Do
    HexL := HexW (HighWord) + HexW (LowWord);
End;

Function HexPtr (P : Pointer) : String;
  {-Return hex string for pointer}
Begin
  HexPtr := HexW (OS (P).S) + ':' + HexW (OS (P).O);
End;

Function Str2Word (S : String; Var I : Word) : Boolean;
  {-Convert a string to a word, returning true if successful}
Var
  Code : SysInt;
  SLen : Byte;

Begin
  SLen := Length (S);

  While S [SLen] = ' ' Do Dec (SLen);

  If (SLen > 1) And
     (UpCase (S [SLen] ) = 'H') Then
  Begin
    Move (S [1], S [2], SLen - 1);
    S [1] := '$';
  End Else If (SLen > 2) And (S [1] = '0') And (UpCase (S [2] ) = 'X') Then
  Begin
    Dec (SLen);
    Move (S [3], S [2], SLen - 1);
    S [1] := '$';
  End;                                                          {!!.21 end}

  Val (S, I, Code);

  If Code <> 0 Then
  Begin
    i := Code;
    Str2Word := False;
  End Else
    Str2Word := True;
End;

Function Long2Str (L : LongInt) : String;
  {-Convert a long/word/integer/byte/shortint to a string}
Var
  S : String;
Begin
  Str (L, S);
  Long2Str := S;
End;

Function Real2Str (R : Float; Width : Byte; Places : ShortInt) : String;
  {-Convert a real to a string}
Var
  S : String;
Begin
  Str (R: Width: Places, S);
  Real2Str := S;
End;

Function FormPrim (Mask : String; R : Float; AssumeDP : Boolean) : String; {!!.21}
  {-Returns a formatted string with digits from R merged into the Mask}
Type
  FillType = (Blank, Asterisk, Zero);

Const
  FormChars : String [8] = '#@*$-+,.';
  PlusArray : Array [Boolean] Of Char = ('+', '-');
  MinusArray : Array [Boolean] Of Char = (' ', '-');
  FillArray : Array [FillType] Of Char = (' ', '*', '0');

Var
  S : String;              {temporary string}
  Filler : FillType;       {char for unused digit slots: ' ', '*', '0'}
  WontFit,                 {true if number won't fit in the mask}
  AddMinus,                {true if minus sign needs to be added}
  Dollar,                  {true if floating dollar sign is desired}
  Negative : Boolean;      {true if B is negative}
  StartF,                  {starting point of the numeric field}
  EndF : Word;             {end of numeric field}
  DotPos,                  {position of '.' in Mask}
  Digits,                  {total # of digits}
  Places,                  {# of digits after the '.'}
  Blanks,                  {# of blanks returned by Str}
  FirstDigit,              {pos. of first digit returned by Str}
  Extras,                  {# of extra digits needed for special cases}
  DigitPtr : Byte;         {pointer into temporary string of digits}
  I : Word;

Label
  EndFound,
  RedoCase,
  Done;

Begin
  {assume decimal point at end?}
  If AssumeDP And (Mask <> '') And (Length (Mask) < 255) Then Begin
  {$IFNDEF WIN32}
    Inc (Mask [0] );
  {$ELSE}
    SetLength (Mask, Length (Mask)+1);
  {$ENDIF}
    Mask [Length (Mask) ] := '.';
  End;                      {!!.21}
  {else}                    {!!.21}
  {AssumeDP := False;}    {!!.21}

  {check for empty string}
  If Length (Mask) = 0 Then
    Goto Done;

  {initialize variables}
  Filler := Blank;
  DotPos := 0;
  Places := 0;
  Digits := 0;
  Dollar := False;
  AddMinus := True;
  StartF := 1;

  {store the sign of the real and make it positive}
  Negative := (R < 0);
  R := Abs (R);

  {find the starting point for the field}
  While (StartF <= Length (Mask) ) And (Pos (Mask [StartF], FormChars) = 0) Do
    Inc (StartF);
  If StartF > Length (Mask) Then
    Goto Done;

  {find the end point for the field}
  For EndF := StartF To Length (Mask) Do
    Case Mask [EndF] Of
      '*' : Filler := Asterisk;
      '@' : Filler := Zero;
      '$' : Dollar := True;
      '-',
      '+' : AddMinus := False;
      '#' : {ignore} ;
      ',' :
           Begin
             DotPos := EndF;
             If CommaForPeriod Then
               Mask [EndF] := '.';
           End;
      '.' :
           Begin
             DotPos := EndF;
             If CommaForPeriod Then
               Mask [EndF] := ',';
           End;
      Else
        Goto EndFound;
    End;

  {if we get here at all, the last char was part of the field}
  Inc (EndF);

  EndFound:
  {if we jumped to here instead, it wasn't}
  Dec (EndF);

  {disallow Dollar if Filler is Zero}
  If Filler = Zero Then
    Dollar := False;

  {we need an extra slot if Dollar is True}
  Extras := Ord (Dollar);

  {get total # of digits and # after the decimal point}
  For I := StartF To EndF Do
    Case Mask [I] Of
      '#', '@',
      '*', '$' :
                Begin
                  Inc (Digits);
                  If (I > DotPos) And (DotPos <> 0) Then
                    Inc (Places);
                End;
    End;

  {need one more 'digit' if Places > 0}
  Inc (Digits, Ord (Places > 0) );

  {also need an extra blank if (1) Negative is true, and (2) Filler is Blank,
  and (3) AddMinus is true}
  If Negative And AddMinus And (Filler = Blank) Then
    Inc (Extras)
  Else
    AddMinus := False;

  {translate the real to a string}
  Str (R: Digits: Places, S);

  {count number of initial blanks}
  Blanks := 1;
  While S [Blanks] = ' ' Do
    Inc (Blanks);
  FirstDigit := Blanks;
  Dec (Blanks);

  {the number won't fit if (a) S is longer than Digits or (b) the number of
  initial blanks is less than Extras}
  WontFit := (Length (S) > Digits) Or (Blanks < Extras);

  {if it won't fit, fill decimal slots with '*'}
  If WontFit Then Begin
    For I := StartF To EndF Do
      Case Mask [I] Of
        '#', '@', '*', '$' : Mask [I] := '*';
        '+' : Mask [I] := PlusArray [Negative];
        '-' : Mask [I] := MinusArray [Negative];
      End;
    Goto Done;
  End;

  {fill initial blanks in S with Filler; insert floating dollar sign}
  If Blanks > 0 Then
  Begin
    FillChar (S [1], Blanks, FillArray [Filler] );

    {put floating dollar sign in last blank slot if necessary}
    If Dollar Then
    Begin
      S [Blanks] := MoneySign;
      Dec (Blanks);
    End;

    {insert a minus sign if necessary}
    If AddMinus Then S [Blanks] := '-';
  End;

  {put in the digits / signs}
  DigitPtr := Length (S);
  For I := EndF Downto StartF Do
  Begin
    RedoCase:
    Case Mask [I] Of
      '#', '@', '*', '$' :
                            If DigitPtr <> 0 Then Begin
                              Mask [I] := S [DigitPtr];
                              Dec (DigitPtr);
                              If (S [DigitPtr] = '.') And (DigitPtr <> 0) Then
                                Dec (DigitPtr);
                            End
      Else
        Mask [I] := FillArray [Filler];
      ',', '.' :
                  If (I < DotPos) And (DigitPtr < FirstDigit) Then
                  Begin
                    Mask [I] := '#';
                    Goto RedoCase;
                  End;
      '+' : Mask [I] := PlusArray [Negative];
      '-' : Mask [I] := MinusArray [Negative];
    End;
  End;

  Done:
  If AssumeDP Then
  {$IFNDEF WIN32}
    Dec (Mask [0] );
  {$ELSE}
    SetLength (Mask, Length (Mask)-1);
  {$ENDIF}
  FormPrim := Mask; {!!.21}
End;

Function LongIntForm (Mask : String; L : LongInt) : String;
  {-Returns a formatted string with digits from L merged into the Mask}
Begin
  {!!.21 AssumeDP now passed to FormPrim}
  LongIntForm := FormPrim (Mask, L, True);
End;

Function Form (Mask : String; R : Float) : String;
Begin
  {!!.21 guts moved to FormPrim}
  Form := FormPrim (Mask, R, False);
End;

Function PadCh (S : String; CH : Char; Len : Byte) : String;
  {-Return a string right-padded to length len with ch}
Var
  o : String;
  SLen : Byte;

Begin
  SLen := Length (S);
  If SLen >= Len Then
  Begin
    o := S;
  {$IFNDEF WIN32}
    o [0] := Chr (Len);
  {$ELSE}
    SetLength (o, Len);
  {$ENDIF}
  End Else
  Begin
  {$IFNDEF WIN32}
    o [0] := Chr (Len);
  {$ELSE}
    SetLength (o, Len);
  {$ENDIF}
    Move (S [1], o [1], SLen); {!!.01}
    If SLen < 255 Then
      FillChar (o [Succ (SLen) ], Len - SLen, CH);
  End;
  PadCh := o;
End;

Function Pad (S : String; Len : Byte) : String;
  {-Return a string right-padded to length len with blanks}
Begin
  Pad := PadCh (S, ' ', Len);
End;

Function LeftPadCh (S : String; CH : Char; Len : Byte) : String;
  {-Return a string left-padded to length len with ch}
Var
  o : String;
  SLen : Byte;

Begin
  SLen := Length (S);
  If SLen >= Len Then Begin
    o := S;
  {$IFNDEF WIN32}
    o [0] := Chr (Len);
  {$ELSE}
    SetLength (o, Len);
  {$ENDIF}
  End
  Else If SLen < 255 Then
  Begin
  {$IFNDEF WIN32}
    o [0] := Chr (Len);
  {$ELSE}
    SetLength (o, Len);
  {$ENDIF}
    Move (S [1], o [Succ (Word (Len) ) - SLen], SLen); {!!.01}
    FillChar (o [1], Len - SLen, CH);
  End;
  LeftPadCh := o;
End;

Function LeftPad (S : String; Len : Byte) : String;
  {-Return a string left-padded to length len with blanks}
Begin
  LeftPad := LeftPadCh (S, ' ', Len);
End;

Function TrimLead (S : String) : String;
  {-Return a string with leading white space removed}
Var
  I : Word;
Begin
  I := 1;
  While (I <= Length (S) ) And (S [I] <= ' ') Do Inc (I);
  Dec (I); If I > 0 Then Delete (S, 1, I);
  TrimLead := S;
End;

Function TrimTrail (S : String) : String;
  {-Return a string with trailing white space removed}
Var
  SLen : Byte;

Begin
  SLen := Length (S);
  While (SLen > 0) And (S [SLen] <= ' ') Do Dec (SLen);
{$IFNDEF WIN32}
  S [0] := Chr (SLen);
{$ELSE}
  SetLength (S, SLen);
{$ENDIF}
  TrimTrail := S;
End;

Function Trim (S : String) : String;
  {-Return a string with leading and trailing white space removed}
Var
  I : Word;
  SLen : Byte;
Begin
  SLen := Length (S);
  While (SLen > 0) And (S [SLen] = ' ') Do Dec (SLen);
{$IFNDEF WIN32}
  S [0] := Chr (SLen);
{$ELSE}
  SetLength (S, SLen);
{$ENDIF}
  I := 1;
  While (I <= SLen) And (S [I] = ' ') Do Inc (I);
  Dec (I);
  If I > 0 Then Delete (S, 1, I);
  Trim := S;
End;

Function TrimSpaces (S : String) : String;
  {-Return a string with leading and trailing spaces removed}

Var
  I : Word;
  SLen : Byte;

Begin
  SLen := Length (S);
  While (SLen > 0) And (S [SLen] = ' ') Do Dec (SLen);
{$IFNDEF WIN32}
  S [0] := Chr (SLen);
{$ELSE}
  SetLength (S, SLen);
{$ENDIF}
  I := 1;
  While (I <= SLen) And (S [I] = ' ') Do Inc (I);
  Dec (I);
  If I > 0 Then Delete (S, 1, I);
  TrimSpaces := S;
End;

Function CenterCh (S : String; CH : Char; Width : Byte) : String;
  {-Return a string centered in a string of Ch with specified width}
Var
  o : String;
  SLen : Byte;

Begin
  SLen := Length (S);
  If SLen >= Width Then
    CenterCh := S
  Else If SLen < 255 Then
  Begin
  {$IFNDEF WIN32}
    o [0] := Chr (Width);
  {$ELSE}
    SetLength (o, Width);
  {$ENDIF}
    FillChar (o [1], Width, CH);
    Move (S [1], o [Succ ( (Width - SLen) ShR 1) ], SLen); {!!.01}
    CenterCh := o;
  End;
End;

Function WordCount (S : String; WordDelims : CharSet) : Byte;
  {-Given a set of word delimiters, return number of words in S}
Var
  Count : Byte;
  i     : Word;
  SLen  : Byte;

Begin
  Count := 0;
  I := 1;
  SLen := Length (S);

  While I <= SLen Do
  Begin
    {skip over delimiters}
    While (I <= SLen) And (S [I] In WordDelims) Do Inc (I);

    {if we're not beyond end of S, we're at the start of a word}
    If I <= SLen Then Inc (Count);

    {find the end of the current word}
    While (I <= SLen) And Not (S [I] In WordDelims) Do Inc (I);
  End;

  WordCount := Count;
End;

Function WordPosition (N : Byte; S : String; WordDelims : CharSet) : Byte;
  {-Given a set of word delimiters, return start position of N'th word in S}
Var
  Count, SLen   : Byte;
  i             : Word;

Begin
  SLen := Length (S);
  Count := 0;
  I := 1;
  WordPosition := 0;

  While (I <= SLen) And (Count <> N) Do
  Begin
    {skip over delimiters}
    While (I <= SLen) And (S [I] In WordDelims) Do Inc (I);

    {if we're not beyond end of S, we're at the start of a word}
    If I <= SLen Then Inc (Count);

    {if not finished, find the end of the current word}
    If Count <> N
    Then
      While (I <= SLen) And Not (S [I] In WordDelims) Do Inc (I)
    Else
      WordPosition := I;
  End;
End;

Function AsciiCount (S : String; WordDelims : CharSet; Quote : Char) : Byte;
  {!!.13-Given a set of word delimiters, return number of words in S}
Var
  Count, SLen   : Byte;
  i             : Word;
  InQuote       : Boolean;

Begin
  SLen := Length (S);
  Count := 0;
  I := 1;
  InQuote := False;

  While I <= SLen Do Begin
    {skip over delimiters}
    While (I <= SLen) And (S [i] <> Quote) And (S [I] In WordDelims) Do Begin
      If I = 1 Then
        Inc (Count);
      Inc (I);
    End;

    {if we're not beyond end of S, we're at the start of a word}
    If I <= SLen Then
      Inc (Count);

    {find the end of the current word}
    While (I <= SLen) And ( (InQuote) Or (Not (S [I] In WordDelims) ) ) Do Begin
      If S [I] = Quote Then
        InQuote := Not (InQuote);
      Inc (I);
    End;
  End;

  AsciiCount := Count;
End;

Function AsciiPosition (N : Byte; S : String; WordDelims : CharSet; Quote : Char) : Byte;
  {!!.13-Given a set of word delimiters, return start position of N'th word in S}
Var
  Count, SLen   : Byte;
  I             : Word;
  InQuote       : Boolean;

Begin
  SLen := Length (S);
  Count := 0;
  I := 1;
  InQuote := False;
  AsciiPosition := 0;

  While (I <= SLen) And (Count <> N) Do
  Begin
    {skip over delimiters}
    If (I <= SLen) And (S [I] <> Quote) And (S [I] In WordDelims) Then
    Begin
      If I = 1 Then Inc (Count);
      While (S [I] In WordDelims) and (I <= SLen) Do Inc (I);
    End;

    {if we're not beyond end of S, we're at the start of a word}
    If I <= SLen Then Inc (Count);

    {if not finished, find the end of the current word}
    If Count <> N Then
    While (I <= SLen) And ((InQuote) Or (Not (S [I] In WordDelims))) Do
    Begin
      If S [I] = Quote Then InQuote := Not (InQuote);
      Inc (I);
    End Else
    Begin
      If S [i] in WordDelims Then Inc (i);
      AsciiPosition := I;
    End;
  End;
End;

Function ExtractAscii (N : Byte; S : String; WordDelims : CharSet; Quote : Char) : String;
  {!!.13-Given a set of word delimiters, return the N'th word in S}
Var
  I       : Word; {!!.12}
  Len     : Byte;
  InQuote : Boolean;
  Tmp     : String;
  SLen    : Byte;

Begin
{$IFDEF WIN32}
  Tmp := Replicate (' ', Length (S));
{$ELSE}
  Tmp := '';
{$ENDIF}

  SLen := Length (S);
  Len := 0;
  InQuote := False;
  I := AsciiPosition (N, S, WordDelims, Quote);

  If I <> 0 Then
    {find the end of the current word}
    While (I <= SLen) And ( (InQuote) Or (Not (S [I] In WordDelims) ) ) Do
    Begin
      {add the I'th character to result}
      Inc (Len);
      If S [I] = Quote Then
        InQuote := Not (InQuote);
      Tmp [Len] := S [I];
      Inc (I);
    End;

{$IFNDEF WIN32}
  Tmp [0] := Char (Len);
{$ELSE}
  SetLength (Tmp, Len);
{$ENDIF}
  ExtractAscii := Tmp;
End;

Procedure WordWrap (InSt : String; Var OutSt, Overlap : String;
                   Margin : Byte; PadToMargin : Boolean);
  {-Wrap InSt at Margin, storing the result in OutSt and the remainder
    in Overlap}
Var
  InStLen, OutStLen, OvrLen : Byte;
  EOS, BOS                  : Word;

Begin
  InStLen := Length (InSt);

  {find the end of the output string}
  If InStLen > Margin Then Begin
    {find the end of the word at the margin, if any}
    EOS := Margin;
    While (EOS <= InStLen) And (InSt [EOS] <> ' ') Do
      Inc (EOS);
    If EOS > InStLen Then
      EOS := InStLen;

    {trim trailing blanks}
    While (InSt [EOS] = ' ') And (EOS > 0) Do
      Dec (EOS);

    If EOS > Margin Then Begin
      {look for the space before the current word}
      While (EOS > 0) And (InSt [EOS] <> ' ') Do
        Dec (EOS);

      {if EOS = 0 then we can't wrap it}
      If EOS = 0 Then
        EOS := Margin
      Else
        {trim trailing blanks}
        While (InSt [EOS] = ' ') And (EOS > 0) Do
          Dec (EOS);
    End;
  End
  Else
    EOS := InStLen;

  {copy the unwrapped portion of the line}
  OutStLen := EOS;
  Move (InSt [1], OutSt [1], OutStLen); {!!.01}

  {find the start of the next word in the line}
  BOS := EOS + 1;
  While (BOS <= InStLen) And (InSt [BOS] = ' ') Do
    Inc (BOS);

  If BOS <= InStLen Then
  Begin
    {copy from the start of the next word to the end of the line}
    OvrLen := Succ (InStLen - BOS);
    Move (InSt [BOS], Overlap [1], OvrLen); {!!.01}
  End;

  {pad the end of the output string if requested}
  If PadToMargin And (OutStLen < Margin) Then FillChar (OutSt [OutStLen + 1], Margin - OutStLen, ' ');
End;

Function HasExtension (Name : String; Var DotPos : Word) : Boolean;
  {-Return whether and position of extension separator dot in a pathname}
Var
  I : Word;
Begin
  DotPos := 0;
  For I := Length (Name) Downto 1 Do
    If (Name [I] = '.') And (DotPos = 0) Then
      DotPos := I;
  HasExtension := (DotPos > 0) And (Pos ('\', Copy (Name, Succ (DotPos), 64) ) = 0);
End;

Function ForceExtension (Name : String; Ext : ExtStr) : String;
  {-Return a pathname with the specified extension attached}
Var
  DotPos : Word;
Begin
  If HasExtension (Name, DotPos) Then
    ForceExtension := Copy (Name, 1, DotPos) + Ext
  Else If Name = '' Then
    ForceExtension := ''
  Else
    ForceExtension := Name + '.' + Ext;
End;

Function JustExtension (Name : String) : ExtStr;
  {-Return just the extension of a pathname}
Var
  DotPos : Word;
Begin
  If HasExtension (Name, DotPos) Then
    JustExtension := Copy (Name, Succ (DotPos), ExtLen)
  Else
    JustExtension := '';
End;

Function JustFilename (PathName : String) : String;
  {-Return just the filename of a pathname}
Var
  I : Word;
Begin
  I := Succ (Word (Length (PathName) ) );
  Repeat
    Dec (I);
  Until (PathName [I] In DosDelimSet) Or (I = 0);
  JustFilename := Copy (PathName, Succ (I), 64);
End;

Function JustName (PathName : String) : String;
  {-Return just the name (no extension, no path) of a pathname}
Var
  DotPos : Byte;
Begin
  PathName := JustFileName (PathName);
  DotPos := Pos ('.', PathName);
  If DotPos > 0 Then
    PathName := Copy (PathName, 1, DotPos - 1);
  JustName := PathName;
End;

Function JustPathname (PathName : String) : String;
  {-Return just the drive:directory portion of a pathname}
Var
  I : Word;
  Tmp : String;

Begin
  If PathName = '.' Then
  Begin
    JustPathName := PathName;
    Exit;
  End;

  I := Succ (Word (Length (PathName) ) );
  Repeat
    Dec (I);
  Until (PathName [I] In DosDelimSet) Or (I = 0);

  If I = 0 Then
    {Had no drive or directory name}
    Tmp := ''
  Else If I = 1 Then
    {Either the root directory of default drive or invalid pathname}
    Tmp := PathName [1]
  Else If (PathName [I] = '\') Then Begin
    If PathName [Pred (I) ] = ':' Then
      {Root directory of a drive, leave trailing backslash}
      Tmp := Copy (PathName, 1, I)
    Else
      {Subdirectory, remove the trailing backslash}
      Tmp := Copy (PathName, 1, Pred (I) );
  End Else
    {Either the default directory of a drive or invalid pathname}
    Tmp := Copy (PathName, 1, I);
  JustPathName := Tmp;
End;

Function AddBackSlash (DirName : String) : String;
  {-Add a default backslash to a directory name}
Begin
  If Trim (DirName) <> '' Then
  Begin
    If DirName [Length (DirName)] In DosDelimSet Then
      AddBackSlash := DirName
    Else
      AddBackSlash := DirName + '\';
  End Else
    AddBackSlash := '';
End;

Function CleanFileName (FileName : String) : String;
  {-Return filename with at most 8 chars of name and 3 of extension}
Var
  DotPos : Word;
  namelen : Word;
Begin
  If HasExtension (FileName, DotPos) Then Begin
    {Take the first 8 chars of name and first 3 chars of extension}
    namelen := Pred (DotPos);
    If namelen > 8 Then
      namelen := 8;
    CleanFileName := Copy (FileName, 1, namelen) + Copy (FileName, DotPos, 4);
  End Else
    {Take the first 8 chars of name}
    CleanFileName := Copy (FileName, 1, 8);
End;

Function CleanPathName (PathName : String) : String;
  {-Return a pathname cleaned up as DOS will do it}
Var
  I : Word;
  oname : String;
Begin
  oname := '';

  {!!.03} {Remove repeated backslashes}
  I := Succ (Word (Length (PathName) ) );
  Repeat
    Dec (I);
    If I > 2 Then
      If (PathName [I] = '\') And (PathName [I - 1] = '\') Then
        If (PathName [I - 2] <> ':') Then
          Delete (PathName, I, 1);
  Until I <= 0;

  I := Succ (Word (Length (PathName) ) );
  Repeat
    {Get the next directory or drive portion of pathname}
    Repeat
      Dec (I);
    Until (PathName [I] In DosDelimSet) Or (I = 0);

    {Clean it up and prepend it to output string}
    oname := CleanFileName (Copy (PathName, Succ (I), 64) ) + oname;
    If I > 0 Then Begin
      oname := PathName [I] + oname;
      Delete (PathName, I, 255);
    End;
  Until I <= 0;

  CleanPathName := oname;
End;

Function FullPathName (FName : String) : String;
  {-Given FName (known to exist), return a full pathname}
Var
  CurDir : String [64];
  Cpos : Byte;
Begin
  Cpos := Pos (':', FName);
  If Cpos <> 0 Then Begin
    {Drive letter specified}
    If FName [Succ (Cpos) ] = '\' Then
      {Complete path already specified}
      FullPathName := FName
    Else Begin
      {Drive specified, but incomplete path}
      GetDir (Pos (UpCase (FName [1] ), 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'), CurDir);
      FullPathName := AddBackSlash (CurDir) + Copy (FName, Succ (Cpos), 100);
    End;
  End Else Begin
    {No drive specified}
    GetDir (0, CurDir);
    If FName [1] = '\' Then
      {Complete path but no drive}
      FullPathName := Copy (CurDir, 1, 2) + FName
    Else
      {No drive, incomplete path}
      FullPathName := AddBackSlash (CurDir) + FName;
  End;
End;

Function NiceFileName (FName: String; Len: Byte) : String;
Var
  tName: String [80];

Begin
  tName := LoString (FName);
  If Trim (FName) = '' Then
  Begin
    NiceFileName := Replicate (' ', Len);
    Exit;
  End;

  If (JustPathName (FName) <> '') And (JustFileName (FName) <> '') Then
    tName := AddBackSlash (UpString (JustPathName (FName))) +
    LoString (JustFileName (FName));

  If Length (tName) > Len Then
    tName := Copy (tName, 1, 3) + '..' + Copy (tName, Length (tName)-Len+6, Len-5)
  Else
    tName := PadCh (tName, ' ', Len);

  NiceFileName := tName;
End;

Function UpString (par: String): String;
Var
  i: Byte;
  par1: String;

Begin
  par1 := par;
  For i := 1 To Length (par1) Do par1 [i] := UpCase (par1 [i] );
  UpString := par1;
End;

Function LoString (par: String): String;
Var
  i: Byte;
  par1: String;

Begin
  par1 := par;
  For i := 1 To Length (par1) Do par1 [i] := LoCase (par1 [i] );
  LoString := par1;
End;

Function UpCase (C: Char) : Char;
{$IFNDEF OS2}
Assembler;
Asm
  MOV     AL, C
  CMP     AL, 'a'
  JB      @@5
  CMP     AL, 'z'
  JA      @@1                     { Check for Cyrillic uppercase }
  SUB     AL, 32                   { Convert to uppercase }
  JMP     @@5
  @@1:                                    { Cyrillic uppercase }
  CMP     AL, 'а'                  { Char in ['а'..'п'] ? }
  JB      @@5                     { Below... }
  CMP     AL, 'п'
  JA      @@2
  SUB     AL, 32                   { Convert to uppercase }
  JMP     @@5
  @@2:
  CMP     AL, 'p'                  { Char in ['р'..'я'] ? }
  JB      @@5                     { Below... }
  CMP     AL, 'я'
  JA      @@3
  SUB     AL, 80                   { Convert to uppercase }
  JMP     @@5
  @@3:
  CMP     AL, 'ё'
  JE      @@4
  CMP     AL, 'є'
  JE      @@4
  CMP     AL, 'ї'
  JE      @@5
  CMP     AL, 'ў'
  JNE     @@5
  @@4:
  Dec     AL
  @@5:
{$ELSE}
Var
  R : Char;

Begin
  R := C;
  If C in ['a'..'z', 'а'..'п'] Then R := Chr (Ord (C) - 32);
  If C in ['р'..'я'] Then R := Chr (Ord (C) - 80);
  UpCase := R;
{$ENDIF}
End;

{$IFNDEF MSDOS}
Function LoCaseMac (CH : Char) : Char;
  {-Lowercase character macro, no international character support}
Begin
  if CH in ['A'..'Z'] Then LoCaseMac := Chr (Ord (CH) + 32) Else LoCaseMac := CH;
End;
{$ENDIF}

Function LoCase (C: Char) : Char;
{$IFDEF MSDOS}
Assembler;
Asm
  MOV     AL, C                  { load char into AL }
  CMP     AL, 'A'                  { Char in ['A'..'Z'] ? }
  JB      @@5                     { Below... }
  CMP     AL, 'Z'
  JA      @@1                     { Check for Cyrillic lowercase }
  ADD     AL, 32                   { Convert to lowercase }
  JMP     @@5
  @@1:                                    { Cyrillic lowercase }
  CMP     AL, 'А'                  { Char in ['А'..'П'] ? }
  JB      @@5                     { Below... }
  CMP     AL, 'П'
  JA      @@2
  ADD     AL, 32                   { Convert to uppercase }
  JMP     @@5
  @@2:
  CMP     AL, 'Р'                  { Char in ['Р'..'Я'] ? }
  JB      @@5                     { Below... }
  CMP     AL, 'Я'
  JA      @@3
  ADD     AL, 80                   { Convert to lowercase }
  JMP     @@5
  @@3:
  CMP     AL, 'Ё'
  JE      @@4
  CMP     AL, 'Є'
  JE      @@4
  CMP     AL, 'Ї'
  JE      @@5
  CMP     AL, 'Ў'
  JNE     @@5
  @@4:
  Inc     AL
  @@5:
{$ELSE}
Var
  R : Char;

Begin
  R := C;
  If C in ['A'..'Z', 'А'..'П'] Then R := Chr (Ord (C) + 32);
  If C in ['Р'..'Я'] Then R := Chr (Ord (C) + 80);
  LoCase := R;
{$ENDIF}
End;

Function DateStr (DosDate: LongInt): String;
Var
  DT                    : {$IFNDEF WIN32} DOS. {$ENDIF} DateTime;
  OutStr, TempStr       : String [8];

Begin
  UnpackTime (DosDate, DT);
  Str (DT. Month: 2, TempStr);

  If TempStr [1] = ' ' Then OutStr [1] := '0'
                       Else OutStr [1] := TempStr [1];

  OutStr [2] := TempStr [2];
  OutStr [3] := '-';
  Str (DT. Day: 2, TempStr);

  If TempStr [1] = ' ' Then OutStr [4] := '0'
                       Else OutStr [4] := TempStr [1];

  OutStr [5] := TempStr [2];
  OutStr [6] := '-';
  Str (DT. Year: 4, TempStr);

  If TempStr [3] = ' ' Then OutStr [7] := '0'
                       Else OutStr [7] := TempStr [3];

  OutStr [8] := TempStr [4];
  OutStr [0] := #8;
  DateStr := OutStr;
End;

Function TimeStr (DosDate: LongInt): String;
Var
  DT: {$IFNDEF WIN32} DOS. {$ENDIF} DateTime;
  OutStr: String [8];
  TempStr: String [8];

Begin
  UnpackTime (DosDate, DT);
  Str (DT. Hour: 2, TempStr);
  If TempStr [1] = ' ' Then
    OutStr [1] := '0'
  Else
    OutStr [1] := TempStr [1];
  OutStr [2] := TempStr [2];
  OutStr [3] := ':';
  Str (DT. Min: 2, TempStr);
  If TempStr [1] = ' ' Then
    OutStr [4] := '0'
  Else
    OutStr [4] := TempStr [1];
  OutStr [5] := TempStr [2];
  OutStr [6] := ':';
  Str (DT. Sec: 2, TempStr);
  If TempStr [1] = ' ' Then
    OutStr [7] := '0'
  Else
    OutStr [7] := TempStr [1];
  OutStr [8] := TempStr [2];
  OutStr [0] := #8;
  TimeStr := OutStr;
End;

Function CommaStr (Number: LongInt): String;
Var
  StrPos: Integer;
  NumberStr: String;

Begin
  NumberStr := Long2Str (Number);
  StrPos := Length (NumberStr) - 2;
  While StrPos > 1 Do
  Begin
    Insert (',', NumberStr, StrPos);
    StrPos := StrPos - 3;
  End;
  CommaStr := NumberStr;
End;

Function ExtractWord (N : Byte; S : String; WordDelims : CharSet) : String;
  {-Given a set of word delimiters, return the N'th word in S}
Var
  I, Count, Len, SLen : Byte;
  Tmp                 : String;

Begin
  SLen := Length (S);
  Count := 0;
  I := 1;
  Len := 0;
  Tmp := '';

  While (I <= SLen) And (Count <> N) Do Begin
    {skip over delimiters}
    While (I <= SLen) And (S [I] In WordDelims) Do
      Inc (I);

    {if we're not beyond end of S, we're at the start of a word}
    If I <= SLen Then
      Inc (Count);

    {find the end of the current word}
    While (I <= SLen) And Not (S [I] In WordDelims) Do Begin
      {if this is the N'th word, add the I'th character to Tmp}
      If Count = N Then Begin
        Inc (Len);
      {$IFNDEF WIN32}
        Tmp [0] := Char (Len);
      {$ELSE}
        SetLength (Tmp, Len);
      {$ENDIF}
        Tmp [Len] := S [I];
      End;

      Inc (I);
    End;
  End;
  ExtractWord := Tmp;
End;

Function PrString (St: String): String;
Var
  TempStr: String;
  i: Integer;
  NextUp: Boolean;

Begin
  If Length (St) = 0 Then
    PrString := ''
  Else
  Begin
    i := 1;
    NextUp := True;
    TempStr := St;

    While i <= Length (TempStr) Do
    Begin

      If ((TempStr [i] < 'A') Or (TempStr [i] > 'я') Or
         ((TempStr [i] > 'Z') And (TempStr [i] < 'a')))
      Then NextUp := True Else
      If NextUp Then
      Begin
        NextUp := False;
        TempStr [i] := UpCase (TempStr [i]);
      End Else
        TempStr [i] := LoCase (TempStr [i]);

      i := i + 1;
    End;

    PrString := TempStr;
  End;
End;

Function MonthStr (Num: Byte): String;
Begin
  Case Num Of
    01 : MonthStr := 'Jan';
    02 : MonthStr := 'Feb';
    03 : MonthStr := 'Mar';
    04 : MonthStr := 'Apr';
    05 : MonthStr := 'May';
    06 : MonthStr := 'Jun';
    07 : MonthStr := 'Jul';
    08 : MonthStr := 'Aug';
    09 : MonthStr := 'Sep';
    10 : MonthStr := 'Oct';
    11 : MonthStr := 'Nov';
    12 : MonthStr := 'Dec';

    Else
      MonthStr := '???';
  End;
End;

Function FormattedDate (DT: {$IFNDEF WIN32} DOS. {$ENDIF} DateTime; Mask: String): String;
Var
  HourStr, MinStr, SecStr, DStr, MStr : String [2];
  MNStr                               : String [3];
  YStr                                : String [4];
  TmpStr                              : String;
  CurrPos, i                          : Word;

Begin
  TmpStr := Mask;
  Mask := UpString (Mask);
  DStr := Copy (LeftPadCh (Long2Str (Dt. Day), '0', 2), 1, 2);
  MStr := Copy (LeftPadCh (Long2Str (Dt. Month), '0', 2), 1, 2);
  YStr := Copy (LeftPadCh (Long2Str (Dt. Year), '0', 4), 1, 4);
  HourStr := Copy (LeftPadCh (Long2Str (Dt. Hour), '0', 2), 1, 2);
  MinStr := Copy (LeftPadCh (Long2Str (Dt. Min), '0', 2), 1, 2);
  SecStr := Copy (LeftPadCh (Long2Str (Dt. Sec), '0', 2), 1, 2);

  MNStr := MonthStr (Dt. Month);
  If (Pos ('YYYY', Mask) = 0) Then YStr := Copy (YStr, 3, 2);
  CurrPos := Pos ('DD', Mask);

  If CurrPos > 0 Then
  For i := 1 To Length (DStr) Do
  TmpStr [CurrPos + i - 1] := DStr [i];

  CurrPos := Pos ('YY', Mask);
  If CurrPos > 0 Then
  For i := 1 To Length (YStr) Do
  TmpStr [CurrPos + i - 1] := YStr [i];

  CurrPos := Pos ('MM', Mask);
  If CurrPos > 0 Then
  For i := 1 To Length (MStr) Do
  TmpStr [CurrPos + i - 1] := MStr [i];

  CurrPos := Pos ('HH', Mask);
  If CurrPos > 0 Then
  For i := 1 To Length (HourStr) Do
  TmpStr [CurrPos + i - 1] := HourStr [i];

  CurrPos := Pos ('SS', Mask);
  If CurrPos > 0 Then
  For i := 1 To Length (SecStr) Do
  TmpStr [CurrPos + i - 1] := SecStr [i];

  CurrPos := Pos ('II', Mask);
  If CurrPos > 0 Then
  For i := 1 To Length (MinStr) Do
  TmpStr [CurrPos + i - 1] := MinStr [i];

  CurrPos := Pos ('NNN', Mask);
  If CurrPos > 0 Then
  For i := 1 To Length (MNStr) Do
  TmpStr [CurrPos + i - 1] := MNStr [i];

  FormattedDate := TmpStr;
End;

Function ReformatDate (ODate: String; InMask, Mask: String): String;
Var
  Code  : SysInt;
  DT    : {$IFNDEF WIN32} DOS. {$ENDIF} DateTime;

Begin
  If Length (InMask) > 8 Then
    Val (Copy (ODate, Pos ('YY', InMask), 4), DT. Year, Code)
  Else
    Val (Copy (ODate, Pos ('YY', InMask), 2), DT. Year, Code);

  Val (Copy (ODate, Pos ('MM', InMask), 2), DT. Month, Code);
  Val (Copy (ODate, Pos ('DD', InMask), 2), DT. Day, Code);

  If Length (InMask) <= 8 Then
  {If DT. Year < 80 Then Inc (DT. Year, 2000) Else} Inc (DT. Year, 1900);

  ReformatDate := FormattedDate (DT, Mask);
End;

Function Word2TimeStr (CTime: Word): String;
Begin
  Word2TimeStr := LeftPadCh (Long2Str (Hi (CTime) ), '0', 2) + ':' +
  LeftPadCh (Long2Str (Lo (CTime) ), '0', 2);
End;

Function TimeStr2Word (TS: String): Word;
Var
  Vr, Vr2, Code: SysInt;

Begin
  Val (Copy (TS, 1, 2), Vr, Code);
  Val (Copy (TS, 4, 2), Vr2, Code);
  TimeStr2Word := Vr2 + (Vr ShL 8);
End;

Function Az2Str (Str: String; MaxLen: Byte): String; {Convert asciiz to string}
Var
  i      : Word;
  TmpStr : String;

Begin
  Move (Str, TmpStr [1], MaxLen);
{$IFNDEF WIN32}
  TmpStr [0] := Chr (MaxLen);
{$ELSE}
  SetLength (TmpStr, MaxLen);
{$ENDIF}
  i := Pos (#0, TmpStr);
  If i > 0 Then
{$IFNDEF WIN32}
  TmpStr [0] := Chr (i-1);
{$ELSE}
  SetLength (TmpStr, i-1);
{$ENDIF}
  Az2Str := TmpStr;
End;

Procedure Str2Az (Str: String; MaxLen: Byte; Var AZStr); {Convert string to asciiz}
Begin
  If Length (Str) >= MaxLen Then
  Begin
    Str [MaxLen] := #0;
    Move (Str [1], AZStr, MaxLen);
  End
  Else
  Begin
    Str [Length (Str) + 1] := #0;
    Move (Str [1], AZStr, Length (Str) + 1);
  End;
End;

Function IsNumeric (Str: String): Boolean;
Var
  i: Word;

Begin
  IsNumeric := True;
  For i := 1 To Length (Str) Do
    If Not (Str [i] In ['0'..'9'] ) Then IsNumeric := False;
End;

Function PosLastChar (CH: Char; St: String): Word;
Var
  i: Word;

Begin
  i := Length (St);
  While ( (i > 0) And (st [i] <> CH) ) Do Dec (i);
  PosLastChar := i;
End;

Function Replicate;
Var
  S   : String;

Begin
  If N <= 0 Then Replicate := '' Else
  Begin
  {$IFNDEF WIN32}
    S [0] := Chr (N);
  {$ELSE}
    SetLength (S, N);
  {$ENDIF}
    FillChar (S [1], N, C);
    Replicate := S;
  End;
End;

Const
  BadDate  = $FFFF;
  MaxYear  = 2078;

Function IsLeapYear (Year : Integer) : Boolean;
Begin
  IsLeapYear := (Year Mod 4 = 0) And (Year Mod 4000 <> 0) And
  ( (Year Mod 100 <> 0) Or (Year Mod 400 = 0) );
End;

Function DaysInMonth (Month, Year : Integer) : Integer;
Begin
  If Word (Year) < 100 Then Begin
    Inc (Year, 1900);
    If Year < Threshold2000 Then
      Inc (Year, 100);
  End;
  Case Month Of
      1, 3, 5, 7, 8, 10, 12 : DaysInMonth := 31;
      4, 6, 9, 11 : DaysInMonth := 30;
      2 : DaysInMonth := 28 + Ord (IsLeapYear (Year) );
    Else
      DaysInMonth := 0;
  End;
End;

Function Date2Long (Date: String) : LongInt;
Var
  Day, Month, Year, Err: SysInt;

Begin
  Val (Copy (Date, 1, 2), Month, Err);
  Val (Copy (Date, 4, 2), Day, Err);
  Val (Copy (Date, Length (Date)-3, 4), Year, Err);

  If Word (Year) < 100 Then
  Begin
    Inc (Year, 1900);
    If Year < Threshold2000 Then Inc (Year, 100);
  End;

  If (Day > 31) Or (Day < 1) Or (Month > 12) Or (Month < 1) Or (Year < 0) Then Date2Long := BadDate Else
  If (Year = MinYear) And (Month < 3) Then
  If Month = 1 Then Date2Long := Pred (Day) Else Date2Long := Day + 30 Else
  Begin
    If Month > 2 Then Dec (Month, 3) Else
    Begin
      Inc (Month, 9);
      Dec (Year);
    End;
    Dec (Year, MinYear);
    Date2Long := ((LongInt (Year) * 1461) Div 4) + (((153 * Month) + 2) Div 5) + Day + First2Months;
  End;
End;

Function Long2Date (Julian : LongInt): String;
Var
  i                     : LongInt;
  Day, Month, Year      : Integer;

Begin
  If Julian = BadDate Then
  Begin
    Day := 0;
    Month := 0;
    Year := 0;
  End Else
  If Julian <= First2Months Then
  Begin
    Year := MinYear;
    If Julian <= 30 Then
    Begin
      Month := 1;
      Day := Succ (Julian);
    End Else
    Begin
      Month := 2;
      Day := Julian - 30;
    End;
  End Else
  Begin
    I := (4 * LongInt (Julian - First2Months)) - 1; {!!.09}
    Year := I Div 1461;                             {!!.09}
    I := (5 * ((I Mod 1461) Div 4)) + 2;
    Month := I Div 153;
    Day := ((I Mod 153) + 5) Div 5;
    If Month < 10 Then Inc (Month, 3) Else
    Begin
      Dec (Month, 9);
      Inc (Year);
    End;
    Inc (Year, MinYear);
  End;
  Long2Date := LeftPadCh (Long2Str (Month), '0', 2) + '-' +
  LeftPadCh (Long2Str (Day), '0', 2) + '-' + Long2Str (Year);
End;

Function Time2Long;
Var
  iMin, iHour, iSec     : Byte;
  Err                   : SysInt;

Begin
  Val (Copy (Time, 1, 2), iHour, Err);
  Val (Copy (Time, 4, 2), iMin, Err);
  Val (Copy (Time, Length (Time)-1, 2), iSec, Err);
  Time2Long := iHour * 3600 + iMin * 60 + iSec;
End;

Function Str2Long;
Var
  i     : SysInt;
  Temp  : LongInt;

Begin
  St := Trim (St);
  Val (St, Temp, i);
  If i = 0 Then Str2Long := Temp
  Else Str2Long := 0;
End;

Function MidSec;
Var
  Hour, Min, Sec, Sec100 : {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}

Begin
  GetTime (Hour, Min, Sec, Sec100);
  MidSec := Hour * 3600 + Min * 60 + Sec;
End;

Function HowTime;
Var
  m1, m2, m3: Integer;
  sm, ss, sh: String;

Begin
  m1 {минуты} := Trunc (Sec / 60);
  m2 {секунды} := Sec - 60 * m1;
  m3 {часы} := Trunc (m1 / 60);
  m1 := m1 - 60 * m3;
  Str (m1, sm);
  Str (m2, ss);
  Str (m3, sh);
  If Length (sh) = 1 Then sh := '0' + sh;
  If Length (sm) = 1 Then sm := '0' + sm;
  If Length (ss) = 1 Then ss := '0' + ss;
  HowTime := sh + ':' + sm + ':' + ss;
End;

Function FileExists;
Var
  DirInfo       : {$IFDEF WIN32} TSearchRec; {$ELSE} SearchRec; {$ENDIF}

Begin
{$IFDEF WIN32}
  DOSerror :=
{$ENDIF}
  FindFirst (Name, AnyFile-VolumeID-Directory-Hidden, DirInfo);

  FileExists := ({$IFNDEF WIN32} DOS. {$ENDIF} DosError = 0);

{$IFNDEF MSDOS}
{$IFDEF WIN32}
  SysUtils.
{$ENDIF}
  FindClose (DirInfo);
{$ENDIF}

End;

Function StrDate;
Var
  D, M, Y, DOw : {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}
  sD, sM, sY   : String;

Begin
  GetDate (Y, M, D, DOw);
  Str (Y, sY);
  Str (M, sM);
  Str (D, sD);
  If Length (sM) = 1 Then sM := '0' + sM;
  If Length (sD) = 1 Then sD := '0' + sD;
  StrDate := sD + '-' + sM + '-' + sY;
End;

Function StrTime;
Var
  h, m, s, s100 : {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}
  sh, sm, ss    : String [4];

Begin
  GetTime (h, m, s, s100);
  Str (h, sh);
  Str (m, sm);
  Str (s, ss);
  If Length (sh) = 1 Then sh := '0' + sh;
  If Length (sm) = 1 Then sm := '0' + sm;
  If Length (ss) = 1 Then ss := '0' + ss;
  StrTime := sh + ':' + sm + ':' + ss;
End;

Function FileDate (Name: String): LongInt;
Var
  F     : {$IFNDEF WIN32} File;
          {$ELSE} THandle; {$ENDIF}
  FTime : LongInt;

Begin
{$IFNDEF WIN32}
  Assign (F, Name);
  {$IFDEF OS2}
  ReSet (F);
  {$ENDIF}
{$ELSE}
  F := FileOpen (Name, fmOpenRead Or fmShareDenyNone);
{$ENDIF}

{$IFNDEF WIN32}
  GetFTime (F, FTime);
{$ELSE}
  FTime := FileGetDate (F);
{$ENDIF}

{$IFDEF OS2}
  Close (F);
{$ENDIF}
  FileDate := FTime;
End;

Function gFileSize;
Var
  DirInfo       : {$IFDEF WIN32} TSearchRec; {$ELSE} SearchRec; {$ENDIF}

Begin
{$IFDEF WIN32}
  DOSerror :=
{$ENDIF}
  FindFirst (Name, AnyFile-VolumeID-Directory, DirInfo);
  If {$IFNDEF WIN32} DOS. {$ENDIF} DosError = 0 Then gFileSize := DirInfo. Size Else gFileSize := 0;
  {$IFNDEF MSDOS}
  {$IFDEF WIN32} SysUtils. {$ENDIF} FindClose (DirInfo);
  {$ENDIF}
End;

Function gFileAttr;
Var
  DirInfo       : {$IFDEF WIN32} TSearchRec; {$ELSE} SearchRec; {$ENDIF}

Begin
{$IFDEF WIN32}
  DosError :=
{$ENDIF}
  FindFirst (Name, AnyFile-VolumeID-Directory, DirInfo);
  If {$IFNDEF WIN32} DOS. {$ENDIF} DosError = 0 Then gFileAttr := DirInfo. Attr Else gFileAttr := 0;
  {$IFNDEF MSDOS}
  {$IFDEF WIN32} SysUtils. {$ENDIF} FindClose (DirInfo);
  {$ENDIF}
End;

Function CompareDates;
Var
{$IFNDEF WIN32}
  Result,
{$ENDIF}
  t1, t2, t3, t4        : LongInt;
  Date1, Date2, Time1,
  Time2                 : String [20];
  Err                   : SysInt;

Label
  EndF;

Begin
  Date1 := ExtractWord (1, S1, [' ']); Time1 := ExtractWord (2, S1, [' ']);
  Date2 := ExtractWord (1, S2, [' ']); Time2 := ExtractWord (2, S2, [' ']);

  Result := 0;
  Val (Copy (Date1, 7, 4), t1, err);
  Val (Copy (Date2, 7, 4), t2, err);
  If t1 <> t2 Then If t1 > t2 Then Result := 1 Else Result := 2;
  If Result <> 0 Then Goto EndF; Result := 0;

  Val (Copy (Date1, 4, 2), t1, err); Val (Copy (Date2, 4, 2), t2, err);
  If t1 <> t2 Then If t1 > t2 Then Result := 1 Else Result := 2;
  If Result <> 0 Then Goto EndF; Result := 0;

  Val (Copy (Date1, 1, 2), t1, err); Val (Copy (Date2, 1, 2), t2, err);
  If t1 <> t2 Then If t1 > t2 Then Result := 1 Else Result := 2;

  If (Result = 0) and (Time1 <> '') and (Time2 <> '') Then
  Begin
    Val (ExtractWord (1, Time1, [':']), t1, err);
    Val (ExtractWord (2, Time1, [':']), t2, err);

    Val (ExtractWord (1, Time2, [':']), t3, err);
    Val (ExtractWord (2, Time2, [':']), t4, err);

    If t1 > t3 Then Result := 1 Else
    If t1 < t3 Then Result := 2 Else
    Result := 0;

    If Result = 0 Then
    If t2 > t4 Then Result := 1 Else
    If t2 < t4 Then Result := 2 Else
    Result := 0;

  End;

  EndF:
{$IFNDEF WIN32}
  CompareDates := Result;
{$ENDIF}
End;

Procedure GregorianToJulianDN (Year, Month, Day: Integer; Var JulianDN: LongInt);
Var
  Century, XYear: LongInt;

Begin
  If Month <= 2 Then
  Begin
    Year  := Pred (Year);
    Month := Month + 12;
  End;

  Month    := Month - 3;
  Century  := Year Div 100;
  XYear    := Year Mod 100;
  Century  := (Century * D1) ShR 2;
  XYear    := (XYear * D0) ShR 2;
  JulianDN := ( ( ( (Month * 153) + 2) Div 5) + Day) + D2 + XYear + Century;
End;

Procedure JulianDNToGregorian (JulianDN: LongInt; Var Year, Month, Day : Word);
Var
  Temp, XYear: LongInt;
  YYear, YMonth, YDay: Integer;

Begin
  Temp     := (((JulianDN - D2) ShL 2) - 1);
  XYear    := (Temp Mod D1) Or 3;
  JulianDN := Temp Div D1;
  YYear    := (XYear Div D0);
  Temp     := ((((XYear Mod D0) + 4) ShR 2) * 5) - 3;
  YMonth   := Temp Div 153;
  If YMonth >= 10 Then
  Begin
    YYear  := YYear + 1;
    YMonth := YMonth - 12;
  End;

  YMonth := YMonth + 3;
  YDay   := Temp Mod 153;
  YDay   := (YDay + 5) Div 5;
  Year   := YYear + (JulianDN * 100);
  Month  := YMonth;
  Day    := YDay;
End;

Function ToUnixDate;
Var
  DT                            : {$IFNDEF WIN32} DOS. {$ENDIF} DateTime;
  DateNum, SecsPast, DaysPast   : LongInt;

Begin
  UnpackTime (FDate, DT);
  GregorianToJulianDN (DT. Year, DT. Month, DT. Day, DateNum);
  DaysPast := DateNum - c1970;
  SecsPast := DaysPast * 86400;
  SecsPast := SecsPast + DT. Hour * 3600 + DT. Min * 60 + DT. Sec;
  ToUnixDate := SecsPast;
End;

Function GetUnixDate;
Var
  DOW, Sec100                   : {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}
  DateNum, SecsPast,
  DaysPast                      : LongInt;

  DTYear, DTMonth, DTDay,
  DTHour, DTMin, DTSec          : {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}

Begin
  GetDate (DTYear, DTMonth, DTDay, DOW);
  GetTime (DTHour, DTMin, DTSec, Sec100);
  GregorianToJulianDN (DTYear, DTMonth, DTDay, DateNum);
  DaysPast := DateNum - c1970;
  SecsPast := DaysPast * 86400;
  SecsPast := SecsPast + DTHour * 3600 + DTMin * 60 + DTSec;
  GetUnixDate := SecsPast;
End;

Function UnixDate2Time (UnixDate: LongInt): String;
Var
  DT: {$IFNDEF WIN32} DOS. {$ENDIF} DateTime;

Begin
  UnixDate := UnixDate Mod 86400;
  DT. Hour := UnixDate Div 3600;
  UnixDate := UnixDate Mod 3600;
  DT. Min := UnixDate Div 60;
  DT. Sec := UnixDate Mod 60;
  UnixDate2Time := LeftPadCh (Long2Str (DT. Hour), '0', 2) + ':' +
  LeftPadCh (Long2Str (DT. Min), '0', 2) + ':' +
  LeftPadCh (Long2Str (DT. Sec), '0', 2);
End;

Function UnixDate2Date;
Var
  DT            : {$IFNDEF WIN32} DOS. {$ENDIF} DateTime;
  DateNum       : LongInt;

Begin
  DateNum := (UnixDate Div 86400) + c1970;
{$IFDEF WIN32}
  JulianDNToGregorian (DateNum, DT. Year, DT. Month, DT. Day);
{$ELSE}
  JulianDNToGregorian (DateNum, Word (DT. Year), Word (DT. Month), Word (DT. Day));
{$ENDIF}
  UnixDate2Date := LeftPadCh (Long2Str (DT. Month), '0', 2) + '-' +
  LeftPadCh (Long2Str (DT. Day), '0', 2) + '-' +
  LeftPadCh (Copy (Long2Str (DT. Year), Length (Long2Str (DT. Year))-1, 2), '0', 2);
End;

Function FromUnixDate;
Var
  DT            : {$IFNDEF WIN32} DOS. {$ENDIF} DateTime;
  DateNum       : LongInt;

Begin
  DateNum := (UnixDate Div 86400) + c1970;
  JulianDNToGregorian (DateNum, Word (DT. Year), Word (DT. Month), Word (DT. Day));
  UnixDate := UnixDate Mod 86400;
  DT. Hour  := UnixDate Div 3600;
  UnixDate := UnixDate Mod 3600;
  DT. Min   := UnixDate Div 60;
  DT. Sec   := UnixDate Mod 60;
  PackTime (DT, UnixDate);
  FromUnixDate := UnixDate;
End;

Function DateL;
Begin
  DateL := Date2Long (ReFormatDate (StrDate, 'DD-MM-YYYY', DefaultDateMask));
End;

Function DateTime2UnixDate(DT : {$IFNDEF WIN32} DOS. {$ENDIF} DateTime) : LongInt;
Var
  DateNum, SecsPast, dth, DaysPast: LongInt;

Begin
  GregorianToJulianDN (DT. Year, DT. Month, DT.Day, DateNum);
  DaysPast := DateNum - c1970;
  SecsPast := DaysPast * 86400;
  DTH := Dt. Hour;
  SecsPast := SecsPast + DTH * 3600 + DT. Min * 60 + DT. Sec;
  DateTime2UnixDate := SecsPast;
End;

Procedure UnixDate2DateTime (UnixDate: LongInt; Var DT: {$IFNDEF WIN32} DOS. {$ENDIF} DateTime);
Var
  DateNum                       : LongInt;
  tmpDay, tmpMonth, tmpYear     : Word;

Begin
  DateNum := (UnixDate Div 86400) + c1970;
  JulianDNToGregorian (DateNum, tmpYear, tmpMonth, tmpDay);

  DT. Day := tmpDay;
  DT. Month := tmpMonth;
  DT. Year := tmpYear;

  UnixDate := UnixDate Mod 86400;
  DT. Hour := UnixDate Div 3600;
  UnixDate := UnixDate Mod 3600;
  DT. Min := UnixDate Div 60;
  DT. Sec := UnixDate Mod 60;
End;

Function Hi4;
Begin
  Hi4 := b Div $10
End;

Function Lo4;
Begin
  Lo4 := b Mod $10
End;

Function Color2Byte (Color: String): Byte;
Const
  Colorz : Array [0..15] Of String [12] =
  ('black', 'blue', 'green', 'cyan', 'red', 'magenta', 'brown',
  'lightgray', 'darkgray', 'lightblue', 'lightgreen', 'lightcyan',
  'lightred', 'lightmagenta', 'yellow', 'white');

Var
  TextColor, BackgroundColor    : Byte;
  sTextColor, sBackgroundColor  : String [12];

Begin
  sTextColor := ExtractWord (1, Color, ['/'] );
  TextColor := 0;

  While (Colorz [TextColor] <> LoString (sTextColor) ) And
        (TextColor <= 15)
  Do Inc (TextColor);

  sBackgroundColor := ExtractWord (2, Color, ['/'] );
  BackgroundColor := 0;
  While (Colorz [BackgroundColor] <> LoString (sBackgroundColor)) And
        (BackgroundColor <= 15)
  Do Inc (BackgroundColor);

  If TextColor > 15 Then TextColor := 7;
  If BackgroundColor > 15 Then BackgroundColor := 0;
  Color2Byte := BackgroundColor * 16 + TextColor;
End;

Function HexOne (H: Char): Byte;
Begin
  HexOne := 0;
  If H In ['A'..'F'] Then HexOne := Ord (H) - $37
  Else If H In ['0'..'9'] Then HexOne := Ord (H) - $30;
End;

Function Hex2Byte (S: String): Byte;
Var
  B, i: Byte;

Begin
  B := 0;
  For i := 1 To Length (s) Do B := (B ShL 4) + HexOne (S [i] );
  Hex2Byte := B;
End;

Function Hex2Word (S: String): Word;
Var
  W: Word;
  i: Byte;

Begin
  W := 0;
  For i := 1 To Length (S) Do W := (W ShL 4) + HexOne (S [i] );
  Hex2Word := W;
End;

Function Hex2Long (S: String): LongInt;
Var
  L: LongInt;
  i: Byte;

Begin
  L := 0;
  For i := 1 To Length (S) Do L := (L ShL 4) + HexOne (S [i] );
  Hex2Long := L;
End;

Function YNA2Bool (YNA: AskType): Boolean;
Begin
  YNA2Bool := (YNA In [atYes, atAsk]);
End;

Function Time2Str (T: tTime): String;
Begin
  Time2Str := LeftPadCh (Long2Str (T Div MinInHour), '0', 2) + ':' +
  LeftPadCh (Long2Str (T Mod MinInHour), '0', 2);
End;

Function Str2Time (s: String): tTime;
Var
  H, M: Word;

Begin
  Str2Time := BadTime;
  If (Pos (':', s) < 2) Or (Length (s) < 4) Then Exit;
  If Not ( Str2Word (Copy (s, 1, Pred (Pos (':', s) ) ), H) And
     Str2Word (Copy (s, Succ (Pos (':', s) ), 2), M) )
  Then Exit;
  If (H > 23) Or (M > 59) Then Exit;
  Str2Time := H * MinInHour + M;
End;

Function Str2TimePeriod;
Var
  s1    : String;
  i     : SysInt;
  b     : Byte;

Begin
  FillChar (TPer, SizeOf (tTimePeriod), 0);
  TPer. rDOW := $60;

  If LoString (s) = 'cm' Then With TPer Do
  Begin   {кpуглосуточно}
    rtBegin := 0;
    rtEnd := MaxTime;
    Str2timePeriod := True;
    Exit;
  End;

  s1 := Copy (s, 1, Pred (Pos ('-', s) ) );
  Delete (s, 1, Pos ('-', s) );

  Str2timePeriod := False;

  With TPer Do Begin
    If Pos ('.', s) <> 0 Then Begin
      Val (Copy (s1, 1, 1), b, i);
      If b = 7 Then b := 0;
      If b > 6 Then Exit;
      rDOW := b;
      Val (Copy (s, 1, 1), b, i);
      If b = 7 Then b := 0;
      If b > 6 Then Exit;
      rDOW := rDOW Or (b ShL 4);
    End;

    If Pos (':', s1) <> 0 Then
      rtBegin := Str2Time (Copy (s1, Succ (Pos ('.', s1) ), 5) )
    Else
      rtBegin := Str2Time (Copy (s, Succ (Pos ('.', s) ), 5) );

    rtEnd := Str2Time (Copy (s, Succ (Pos ('.', s) ), 5) );

    If rtEnd = BadTime Then rtEnd := MaxTime;
  End;

  Str2timePeriod := True;
End;

Function TimePeriod2Str (TPer: tTimePeriod): String;
Begin
  With TPer Do
    TimePeriod2Str := Copy (sDOW [DayType (rDOW And $F) ], 1, 3) + '─' +
    Copy (sDOW [DayType (rDOW ShR 4) ], 1, 3) + ' / ' +
    Time2Str (rtBegin) + '-' +
    Time2Str (rtEnd);
End;

Function CurTime: tTime;
Var
  H, M, w: {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}

Begin
  GetTime (H, M, w, w);
  CurTime := H * MinInHour + M;
End;

Function MatchTimePeriod (TPer: tTimePeriod): Boolean;
Var
  w, DoW: {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}
  cT: tTime;

Function MatchDay: Boolean;
Begin
  With TPer Do

    {День пеpвой гpаницы > Дня втоpой гpаницы 6.00:00-3.22:10}
    If (rDOW And $F) > (rDOW ShR 4) Then
      If (DoW <= (rDOW ShR 4) ) Or (DoW >= (rDOW And $F) ) Then MatchDay := True
      Else MatchDay := False
    Else
      {День пеpвой гpаницы <= Дню втоpой гpаницы}
      If ( (rDOW And $F) <= DoW) And                  {тек.день >= нач.пеpиода _И_}
         ( (rDOW ShR 4) >= DoW)
      Then MatchDay := True   {тек.день <= кон.пеpиода}
      Else MatchDay := False;
End;

Function MatchTime: Boolean;
Begin
  With TPer Do

    {Если вpемя пеpвой гpаницы > вpемени втоpой гpаницы 21:00-03:00 }
    If rtBegin > rtEnd Then
      If (cT <= rtEnd) Or (cT >= rtBegin) Then MatchTime := True
      Else MatchTime := False
    Else
      If (cT >= rtBegin) And (cT <= rtEnd) Then MatchTime := True
      Else MatchTime := False;
End;

Begin
  {-получаем день недели и вpемя}
  GetDate (w, w, w, DoW);
  cT := CurTime;           { текущее вpемя в виде WORD (в минутах)}

  { with TPer do
  if (rDOW shr 4) =0 then rDOW:=rDOW or $70;}

  MatchTimePeriod := MatchDay And MatchTime;
End;

Function MatchTimeArray (Var TA: TimeArray): Boolean;
Var
  i : Byte;

Begin
  MatchTimeArray := False;
  If TA. nTPer = 0 Then Exit;

  For i := 1 To TA. nTPer Do
  If MatchTimePeriod (TA. TPer [i]) Then
  Begin
    MatchTimeArray := True;
    Exit;
  End;
End;

Function Str2timeArray (s: String; Var TA: TimeArray): Boolean;
Var
  z: Byte;

Begin
  FillChar (TA, SizeOf (TA), #0);
  Str2TimeArray := False;

  If Length (s) <> 0 Then
  Begin
    For z := 1 To WordCount (s, [','] ) Do
    With TA Do
    Begin
      If Str2TimePeriod (ExtractWord (z, s, [','] ), TPer [Succ (nTPer) ] ) Then Inc (nTPer);
      If z = 7 Then
      Begin
        Str2timeArray := TA. nTPer <> 0;
        Exit;
      End;
    End;
    Str2timeArray := TA. nTPer <> 0;
  End;
End;

Function tCopyFile (SourceFile, TargetFile: String; OverWrite: Boolean): Boolean;
{$IFDEF WIN32}
Var
  S1, S2: PChar;

Begin
  GetMem (S1, Length (SourceFile)+1);
  GetMem (S2, Length (TargetFile)+1);
  S1 := StrPCopy (S1, SourceFile);
  S2 := StrPCopy (S2, TargetFile);
  tCopyFile := FileExists (SourceFile);
  CopyFile (S1, S2, OverWrite);
  FreeMem (S1, Length (SourceFile)+1);
  FreeMem (S2, Length (TargetFile)+1);
End;
{$ELSE}
Var
  Source, Target        : File;
  BRead, BWrite         : SysInt;
  FileBuf               : Array [1..2048] Of Char;
  FTime                 : LongInt;
  Attr                  : {$IFNDEF OS2} Word {$ELSE} LongInt {$ENDIF};

Begin
  tCopyFile := False;

  If SourceFile = TargetFile Then
  If Not OverWrite Then Exit;

  Assign (Source, SourceFile);
  System. FileMode := 0;
  Reset (Source, 1);
  System. FileMode := 2;

  If IOResult <> 0 Then Exit;

  Assign (Target, TargetFile);
  ReWrite (Target, 1);

  If IOResult <> 0 Then Exit;

  Repeat
    BlockRead (Source, FileBuf, SizeOf (FileBuf), BRead);
    BlockWrite (Target, FileBuf, Bread, BWrite);
  Until (BRead = 0) Or (BRead <> BWrite);

  GetFTime (Source, FTime);
  SetFTime (Target, FTime);

  Close (Target);

  System. FileMode := 0;
  ReSet (Target);
  System. FileMode := 2;

  GetFAttr (Source, Attr);
  SetFAttr (Target, Attr);

  Close (Target);
  Close (Source);

  If IOResult <> 0 Then;
  If Bread <> Bwrite Then Erase (Target) Else tCopyFile := True;
End;
{$ENDIF}

Function tDeleteFile (FileName: String): Boolean;
{$IFDEF WIN32}
Var
  S1: PChar;

Begin
  GetMem (S1, Length (FileName)+1);
  S1 := StrPCopy (S1, FileName);
  Try FileSetAttr (S1, faArchive); Except End;
  Try tDeleteFile := DeleteFile (S1); Except End;
  FreeMem (S1, Length (FileName)+1);
End;
{$ELSE}
Var
  F             : File;
  DirInfo       : SearchRec;
  Result        : Boolean;

Begin
  Result := False;
{$IFDEF WIN32}
  DOSerror :=
{$ENDIF}
  FindFirst (FileName, AnyFile-VolumeID-Directory, DirInfo);
  While DOS. DosError = 0 Do
  Begin
    Assign (F, AddBackSlash (JustPathName (FileName)) + DirInfo. Name);
    SetFAttr (F, 0); If IOResult <> 0 Then;
    Erase (F); Result := IOResult = 0;
  {$IFDEF WIN32}
    DOSerror :=
  {$ENDIF}
    FindNext (DirInfo);
  End;
  {$IFDEF OS2}
  FindClose (DirInfo);
  {$ENDIF}

  tDeleteFile := Result;
End;
{$ENDIF}

Function tRenameFile (SourceFile, TargetFile: String): Boolean;
{$IFDEF WIN32}
Var
  S1, S2: PChar;

Begin
  GetMem (S1, Length (SourceFile)+1);
  GetMem (S2, Length (TargetFile)+1);
  S1 := StrPCopy (S1, SourceFile);
  S2 := StrPCopy (S2, TargetFile);
  tRenameFile := RenameFile (S1, S2);
  FreeMem (S1, Length (SourceFile)+1);
  FreeMem (S2, Length (TargetFile)+1);
End;
{$ELSE}
Var
  Source, Target        : File;
  BRead, BWrite         : SysInt;
  FileBuf               : Array [1..2048] Of Char;
  FTime                 : LongInt;

Begin
  tRenameFile := True;

  If SourceFile = TargetFile Then Exit;

  Assign (Source, SourceFile);
  Reset (Source, 1);
  If IOResult <> 0 Then
  Begin
    tRenameFile := False;
    Exit;
  End;

  Assign (Target, TargetFile);
  Rewrite (Target, 1);
  If IOResult <> 0 Then
  Begin
    tRenameFile := False;
    Close (Source);
    Exit;
  End;

  Repeat
    BlockRead (Source, FileBuf, SizeOf (FileBuf), BRead);
    BlockWrite (Target, FileBuf, Bread, BWrite);
  Until (BRead = 0) Or (BRead <> BWrite);

  GetFTime (Source, FTime);
  SetFTime (Target, FTime);

  Close (Target);
  Close (Source);
  Erase (Source);

  If Bread <> Bwrite Then tRenameFile := False;
End;
{$ENDIF}

Function DirExists (Dir: String): Boolean;
Var
  SaveDir       : PathStr;

Begin
  If Dir [Length (Dir)] = '\' Then Dir := Copy (Dir, 1, Length (Dir)-1);
  GetDir (0, SaveDir);
  SmartChDir (Dir);
  DirExists := (IOResult = 0);
  SmartChDir (SaveDir);
End;

Function PlaceSubStr (InSt, WhatSt, ToSt : String): String;
{$IFDEF MSDOS}
Assembler;
Asm
  Push  DS
  Cld

  Lds   SI, @Result
  XOr   CL, CL
  Mov   DS: [SI], CL

  Lds   SI, InSt
  Mov   CL, DS: [SI]
  XOr   CH, CH
  Or    CL, CL
  Jnz   @@Next0

  Lds   BX, WhatSt
  Mov   AL, DS: [BX]
  Or    AL, AL
  Jnz   @@Exit

  Lds   SI, ToSt
  Les   DI, @Result

  Lodsb
  Stosb

  Or   AL, AL
  Jz   @@Exit
  XOr  AH, AH
  Mov  CX, AX

  Rep  Movsb

  Jmp  @@Exit

  @@Next0:
  Inc   CX
  Inc   SI
  Les   DI, @Result
  Inc   DI
  Push  DI
  Les   BX, WhatSt
  Mov   AL, ES: [BX]
  Or    AL, AL
  Jz    @@Exit
  Inc   AL
  XOr   AH, AH
  Add   AX, BX
  Mov   DX, AX

  @@Begin:
  Les   BX, WhatSt
  Inc   BX
  Mov   AH, ES: [BX]
  Les   DI, @Result
  Pop   DI

  @@Loop1:
  Dec   CX
  Or    CX, CX
  Jnz   @@Next1
  Mov   AX, DI
  Dec   AX
  Les   DI, @Result
  Sub   AX, DI
  Mov   ES: [DI], AL
  Jmp   @@Exit

  @@Next1:
  Lodsb
  Stosb
  Cmp   AL, AH
  Jne   @@Loop1

  Push  DI
  Push  SI
  Push  CX
  Les   DI, WhatSt

  @@Loop2:
  Inc   BX
  Cmp   BX, DX
  Jne   @@Next2

  @@Sovpalo:
  Pop   AX {Cx}
  Pop   AX {Si}
  Les   DI, @Result
  Pop   DI
  Dec   DI
  Push  SI
  Push  CX
  Lds   SI, ToSt
  Lodsb
  XOr   AH, AH
  Mov   CX, AX
  Rep   Movsb
  Pop   CX
  Lds   SI, InSt
  Pop   SI
  Push  DI
  Jmp   @@Begin

  @@Next2:
  Dec   CX
  Or    CX, CX
  Jnz   @@Next3
  Pop   CX
  Lds   SI, InSt
  Pop   SI
  Jmp   @@Begin

  @@Next3:
  Mov   AH, ES: [BX]
  Lodsb
  Cmp   AL, AH
  Je    @@Loop2
  Pop   CX
  Lds   SI, InSt
  Pop   SI
  Jmp   @@Begin

  @@Exit:
  Pop   DS

{$ELSE}
Var
  P, LW   : Byte;

Begin
  P := Pos (WhatSt, InSt);
  LW := Length (WhatSt);

  While P > 0 Do
  Begin
    Delete (InSt, P, LW);
    Insert (ToSt, InSt, P);
    P := Pos (WhatSt, InSt);
  End;
  PlaceSubStr := InSt;
{$ENDIF}
End;

Function SymbolCount (S : String; Symbol : Char) : Byte;
  {-Return number of symbols in S}
Var
  I, Count, SLen     : Byte;

Begin
  SLen := Length (S);
  Count := 0;
  For I := 1 To SLen Do
    If S [I] = Symbol Then Inc (Count);
  SymbolCount := Count;
End;

Function MatchWildCard (S1, Mask: PathStr): Boolean;
var
  fname,card    : String;
  f,c,i         : Byte;
  asterisk      : Boolean;

Begin
  if (Mask='*.*') Or (UpString (S1) = UpString (Mask)) then
  begin
    MatchWildCard := True;
    Exit
  end;

  fname:=S1;
  card:=Mask;
  if pos('.',fname)=0 then fname:=fname+'.';
  if pos('.',card)=0 then card:=card+'*.*';
  f:=pos('.',fname);
  c:=pos('.',card);
  for i:=1 to 9-f do
   Insert(' ',fname,f);
  for i:=1 to 9-c do
   Insert(' ',card,c);
  f := Length (fname);
  c := Length (card);
  for i:=1 to 12-f do
   Insert(' ',fname,f+1);
  for i:=1 to 12-c do
   Insert(' ',card,c+1);

  i:=1;
  asterisk:=false;
  repeat
    if card[i]='.' then begin
      asterisk:=false;
      inc(i);
      Continue
    end;
    if asterisk then
      card[i]:='?'
    else begin
      if card[i]='*' then begin
        asterisk:=true;
        card[i]:='?'
      end
      else
        card[i]:=UpCase(card[i])
    end;
    inc(i)
  until i=13;

  for i:=1 to 12 do fname[i]:=UpCase(fname[i]);

  MatchWildCard := False;

  for i:=1 to 12 do
  if (fname[i]<>card[i]) and (card[i]<>'?') then Exit;

  MatchWildCard := True
End;

Function NiceFileSize (Size: LongInt): String;
Var
  sSize  : String [15];

Begin
  sSize := '0K';

  If (Size >= 0) And (Size <= 1024) Then
  Begin
    Str (Size: 4, sSize);
    sSize := sSize + 'b';
  End;

  If (Size >= 1025) And (Size <= 1024000) Then
  Begin
    Str ((Size / 1000): 7: 1, sSize);
    sSize := sSize + 'K';
  End;

  If (Size >= 1024001) Then
  Begin
    Str ( (Size / 1000000): 7: 1, sSize);
    sSize := sSize + 'M';
  End;
  NiceFileSize := Trim (sSize);
End;

Function arMatch (B: Array Of Byte; Arr: Array Of Byte): LongInt;
Var
  i, Match      : LongInt;

Begin
  Match := 0;
  For i := 1 To SizeOf (Arr) Do
  If Arr [i] = B [0] Then
  If SizeOf (Arr) <= i+1 Then
  If Arr [i+1] = B [1] Then Inc (Match);

  arMatch := Match;
End;

Function arPos (B: Array Of Byte; C: Array Of Byte): LongInt;
Var
  i, j  : LongInt;

Begin
  arPos := 0;

  For i := 0 To SizeOf (C) Do
  If (C [i] = B [0]) And (C [i+1] = B [1]) Then

  For j := 1 To SizeOf (B) Do
  If C [i+j] = B [j] Then
  Begin
    If j = SizeOf (B)-1 Then
    Begin
      arPos := i+1;
      Exit;
    End;
  End Else
    Break;

End;

Function CompletePath (Path : PathStr) : PathStr;
  {-Convert a relative directory name into a complete one}
Var
  DrCh                  : Char;
  ColPos                : Byte;
  SaveDir, CurDir       : PathStr;

Begin
  If (Length (Path) = 3) And (Copy (Path, 2, 2) = ':\') Then
  Begin
    CompletePath := Path;
    Exit;
  End;

  If (Length (Path) > 1) And (Path [Length (Path)] = '\') Then
    Path := Copy (Path, 1, Length (Path)-1);

  GetDir (0, CurDir);
  ColPos := Pos (':', Path);
  If ColPos = 2 Then
  Begin
    {Get current directory on specified drive}
    DrCh := UpCase (Path [1] );
    If DrCh >= 'A' Then
      GetDir (Byte (DrCh) - Byte ('A') + 1, SaveDir)
    Else
      ColPos := 0;
  End;

  ChDir (Path);

  {$IFNDEF WIN32} DOS. {$ENDIF} DosError := IOResult;
  If {$IFNDEF WIN32} DOS. {$ENDIF} DosError = 0 Then
  Begin
    GetDir (0, Path);
    If ColPos = 2 Then
    Begin
      {Restore current directory on other drive}
      SmartChDir (SaveDir);
      {Watch out! ChDir may set IoResult}
      If IOResult <> 0 Then;
    End;
  End Else
    {Return empty path for an invalid one}
    {Path := ''};
  SmartChDir (CurDir);
  CompletePath := AddBackSlash (Path);
End;

Function PhoneValid (S: String): Boolean;
Begin
  If (Length (S) = 0) or (Length (S) < 4) Then
  Begin
    PhoneValid := False;
    Exit;
  End;

  PhoneValid := ConsistsOf (S, ['0'..'9', '-', '+', '(', ')', ' ', '[', ']']);
End;

Function ConsistsOf (S: String; Symbols: CharSet): Boolean;
Var
  i     : Byte;

Begin
  ConsistsOf := True;

  If Length (S) = 0 Then
  Begin
    ConsistsOf := False;
    Exit;
  End;

  For i := 1 To Length (S) Do
  If Not (S [i] in Symbols) Then
  Begin
    ConsistsOf := False;
    Exit;
  End;
End;

Function StrContains (S: String; Symbols: CharSet): Boolean;
Var
  i : Byte;

Begin
  StrContains := False;
  If Length (S) = 0 Then Exit Else
  For i := 1 To Length (S) Do
  If S [i] in Symbols Then
  Begin
    StrContains := True;
    Exit;
  End;
End;

Function DateMaskMatch (Date, Mask: String): Boolean;
Var
  tS                    : String [10];
  Err                   : {$IFNDEF OS2} Integer; {$ELSE} LongInt; {$ENDIF}
  Day, Month, Year      : Word;
  i                     : Byte;

Label
  NotValid,
  Valid;

Begin
  If Length (Date) <> Length (Mask) Then GoTo NotValid;

  Val (Copy (Date, Pos ('DD', Mask), 2), Day, Err);
  If (Err <> 0) or (Day = 0) or (Day > 31) Then GoTo NotValid;

  tS := Copy (Date, Pos ('MM', Mask), 2);
  Val (Copy (Date, Pos ('MM', Mask), 2), Month, Err);
  If (Err <> 0) or (Month = 0) or (Month > 12) Then GoTo NotValid;

  If Length (Mask) > 8
  Then
    Val (Copy (Date, Pos ('YYYY', Mask), 4), Year, Err)
  Else
  Begin
    Val (Copy (Date, Pos ('YY', Mask), 2), Year, Err);
    Inc (Year, 1900);
  End;
  If (Err <> 0) or (Year = 0) Then GoTo NotValid;

  For i := 1 To Length (Mask) Do
  Begin
    If Mask [i] in ['-', '.', '/'] Then
    If Date [i] <> Mask [i] Then GoTo NotValid;
  End;

  GoTo Valid;

  NotValid:
  DateMaskMatch := False;
  Exit;

  Valid:
  DateMaskMatch := True;
End;

Function EstimatedTransferTime (Size, CPS, Speed: LongInt): LongInt;
Begin
  If CPS <= 0 Then
  If Speed > 0 Then CPS := Speed div 10 Else CPS := 240;
  EstimatedTransferTime := Size Div CPS;
End;

Function FlagsValid (UserFlags, NeedFlags: String): Boolean;
Var
  i     : Byte;

Begin
  FlagsValid := True;

  For i := 1 To Length (NeedFlags) Do
  If Pos (NeedFlags [i], UserFlags) = 0 Then
  Begin
    FlagsValid := False;
    Exit;
  End;
End;

Function To4D (S: String): String;
Begin
  If Pos ('@', S) <> 0 Then S := Copy (S, 1, Pos ('@', S) - 1);
  If Pos ('.', S) = 0 Then S := S + '.0';
  To4D := S;
End;

Function Addr2Str (Addr: AddrType): String;
Var
  S     : String;

Begin
  If (Addr. Zone = 0) And (Addr. Net = 0) And (Addr. Node = 0) And (Addr. Point = 0)
  Then S := '' Else
  Begin
    S := Long2Str (Addr. Zone) + ':' + Long2Str (Addr. Net) + '/' + Long2Str (Addr. Node);
    If Addr. Point > 0 Then S := S + '.' + Long2Str (Addr. Point);
  End;

  Addr2Str := S;
End;

Procedure ParseStrAddr (StrAddr: String; Var Result: AddrType);
Var
  TmpStr : String [40];

Begin
  TmpStr := To4D (StrAddr);
  FillChar (Result, SizeOf (Result), #0);

  If Pos ('.', TmpStr) = 0 Then TmpStr := TmpStr + '.0';

  Result. Zone  := Str2Long (Copy (TmpStr, 1, Pos (':', TmpStr) - 1 ));
  Result. Net   := Str2Long (Copy (TmpStr, Pos (':', TmpStr) + 1,
                   Pos ('/', TmpStr) - Pos (':', TmpStr) - 1 ));
  Result. Node  := Str2Long (Copy (TmpStr, Pos ('/', TmpStr) + 1,
                   Pos ('.', TmpStr) - Pos ('/', TmpStr) - 1 ));
  Result. Point := Str2Long (Copy (TmpStr, Pos ('.', TmpStr)+1, 255));
End;

Function AddressMatch (Addr, Mask: String): Boolean;
Var
  M, A, R, S    : String [20];
  I, J          : Integer;

Const
  Divs : array [1..3] of Char = (':','/','.');

Begin
  S := '';
  For i := 1 To 4 Do
  Begin
    M := ExtractWord (i, Mask, [':','/','.']);
    A := ExtractWord (i, Addr, [':','/','.']);
    R := '';
    For j := 1 To Length (M) Do
    Begin
      If Not (M [J] In ['*','?']) Then R := R + M [J];
      If M [J] = '?' Then R := R + A [J];
      If M [J] = '*' Then
      Begin
        R := R + Copy (A, J, Byte (A [0]) - J + 1);
        Break;
      End;
    End;

    If M = '' Then R := A;
    S := S + R;
    If i < 4 Then S := S + Divs [i];
  End;

  If (S [Byte (S [0])] = '.') And (Pos ('.', Addr) = 0) Then Dec (Byte (S [0]));
  AddressMatch := Addr = S;
End;

Function DateMatch (Date, Mask: String): Boolean;
Var
  i : Byte;

Begin
  DateMatch := True;
  For i := 1 To Length (Mask) Do
  Begin
    If Mask [i] = '?' Then Continue;
    If Mask [i] <> Date [i] Then
    Begin
      DateMatch := False;
      Exit;
    End;
  End;
End;

Function Crc32Str;
Var
  Crc   : LongInt;
  i     : Byte;

Begin
  Crc := $FFFFFFFF;
  For i := 1 To Length (S) Do Crc := UpdateCrc32 (Byte (S [i]), Crc);
  Crc32Str := Crc;
End;

Function SplitString (Var S: String; Len: Byte): String;
Var
{$IFNDEF WIN32}
  Result,
{$ENDIF}
  Buf           : String;
  i             : Byte;

Begin
  Result := '';
  Buf := '';

  For i := 1 To Length (S) Do
  If (S [i] = ' ') Or (i = Length (S)) Or (i > Len) Then
  Begin
    If Length (Result) + Length (Buf) >= Len Then
    Begin
      If Result = '' Then Result := Buf Else
      If ConsistsOf (Result, [' ']) Then
        Result := Result + Copy (Buf, 1, Len-Length (Result));

      SplitString := Result;
      Delete (S, 1, Length (Result));
      Exit;
    End Else
    Begin
      Result := Result + Buf + S [i];
      Buf := '';
    End;
  End
  Else Buf := Buf + S [i];

  S := '';
{$IFNDEF WIN32}
  SplitString := Result;
{$ENDIF}
End;

Function IsDevice (DevName: String): Boolean;
Const
  DevNum = 18;
  Devices : Array [1..DevNum] Of String [7] =
    ('COM1', 'COM2', 'COM3', 'COM4', 'COM5', 'COM6', 'COM7', 'COM8',
     'CON', 'PRN', 'LPT1', 'LPT2', 'LPT3', 'LPT4', 'CLOCK$', 'NUL',
     'AUX', 'MSCD001');

Var
  i     : Byte;

Begin
  IsDevice := False;
  DevName := UpString (DevName);

  For i := 1 To DevNum Do
  If DevName = Devices [i] Then
  Begin
    IsDevice := True;
    Exit;
  End;
End;

Function DelSpaces (S: String): String;
Var
{$IFNDEF WIN32}
  Result        : String;
{$ENDIF}
  WC, i         : Byte;

Begin
  WC := WordCount (S, [' ']);
  Result := '';

  For i := 1 To WC Do
  Begin
    If Result = '' Then
      Result := ExtractWord (i, S, [' '])
    Else
      Result := Result + ' ' + ExtractWord (i, S, [' ']);
  End;

{$IFNDEF WIN32}
  DelSpaces := Result;
{$ENDIF}
End;

Function ExtractDate (sDate, DateMask: String; Var Year, Month, Day: Word): Boolean;
Var
  Delim                 : Char;
  DatePart, MaskPart    : String [4];
  i                     : Byte;
  Err                   : SysInt;

Begin
  ExtractDate := False;
  DateMask := UpString (DateMask);

  If Pos ('-', DateMask) <> 0 Then Delim := '-' Else
  If Pos ('/', DateMask) <> 0 Then Delim := '/' Else
  If Pos ('.', DateMask) <> 0 Then Delim := '.' Else
  Exit;

  For i := 1 To 3 Do
  Begin
    DatePart := ExtractWord (i, sDate, [Delim]);
    MaskPart := ExtractWord (i, DateMask, [Delim]);

    If MaskPart [1] = 'M' Then Val (DatePart, Month, Err) Else
    If MaskPart [1] = 'D' Then Val (DatePart, Day, Err) Else
    If MaskPart [1] = 'Y' Then
    Begin
      Val (DatePart, Year, Err);
      If Length (MaskPart) < 4 Then Inc (Year, 1900);
    End;
  End;

End;

Procedure Str2Security (S: String; Var Security: Word; Var Flags: String);
Const
  Delimz : Set Of Char = [' ', '|', ',', ':'];

Begin
  Security := Str2Long (Trim (ExtractWord (1, S, Delimz)));

  If WordCount (S, Delimz) > 1 Then
    Flags := Trim (ExtractWord (2, S, Delimz))
  Else
    Flags := '';
End;

Function MatchMultiCard (S1, Mask: PathStr): Boolean;
Var
  WC, i  : Byte;

Begin
  WC := WordCount (Mask, [' ', ',', '|']);
  MatchMultiCard := False;

  For i := 1 To WC Do
  If MatchWildCard (S1, Trim (ExtractWord (i, Mask, [' ', ',', '|']))) Then
  Begin
    MatchMultiCard := True;
    Exit;
  End;
End;

Function WordInString (Word, S: String): Boolean;
Var
  i, WC : Byte;

Begin
  WC := WordCount (S, [' ', ',']);
  Word := Trim (UpString (Word));
  S := Trim (UpString (S));
  WordInString := False;

  For i := 1 To WC Do
  If Trim (ExtractWord (i, S, [' ', ','])) = Word Then
  Begin
    WordInString := True;
    Exit;
  End;
End;

Function MultiFileExists (Path, FileName: PathStr): Boolean;
Var
  i, WC : Byte;

Begin
  WC := WordCount (Path, [' ', ',']);
  MultiFileExists := False;

  For i := 1 To WC Do
  If FileExists (AddBackSlash (ExtractWord (i, Path, [' ', ','])) + FileName) Then
  Begin
    MultiFileExists := True;
    Exit;
  End;
End;

{$IFDEF MSDOS}
Procedure Sleep (Tic: Longint);
Var
  T : Longint;

Begin
  Tic := Trunc (Tic/100);
  T := MemL [Seg0040:$6c];
  While T+Tic > MemL [Seg0040:$6c] Do;
End;
{$ENDIF}

Procedure SoundOf (S: string);
{$IFNDEF WIN32}
{$IFNDEF OS2}
Var
 Count, i, j, NoteCount, Rep    : Word;
 Hz                             : Integer;
 s0                             : String;
{$ENDIF}
{$ENDIF}

Begin
{$IFNDEF WIN32}
{$IFNDEF OS2}
  S := DelSpaces (S);
  NoteCount := WordCount (S, [' '])-1;
  Rep := Str2Long (ExtractWord (1, S, [' ']));

  For j := 1 To Rep Do
  Begin
   i := 0;
   Repeat
     Hz := Str2Long (ExtractWord (2+i, S, [' ']));
     Count:=0;
     Repeat
       If Hz <> -1 Then Sound (Hz) Else NoSound;
       Hz := Hz + Str2Long (ExtractWord (3+i, S, [' ']));

     {$IFDEF OS2}
       DosSleep
     {$ELSE}
       Sleep
     {$ENDIF} (Str2Long (ExtractWord (4+i, S, [' '])));

       Inc (Count)
     Until Count = Str2Long (ExtractWord (5+i, S, [' ']));
     Inc (i, 4);
   Until i >= NoteCount;
   NoSound;
  End;

  NoSound;
{$ENDIF}
{$ENDIF}
{$IFDEF OS2}
  PlaySound (600, 50);
{$ENDIF}
End;

Function YesNo (S: String): Boolean;
Begin
  If UpString (S) = 'YES' Then YesNo := True
                          Else YesNo := False;
End;

Function YesNoDetect (S: String): YesNoAuto;
Begin
  YesNoDetect := ynAuto;
  S := UpString (S);
  If S = 'YES' Then YesNoDetect := ynYes;
  If S = 'NO' Then YesNoDetect := ynNo;
End;

Function YNAsk (S: String): AskType;
Begin
  YNAsk := atAsk;
  S := UpString (S);
  If S = 'YES' Then YNAsk := atYes;
  If S = 'NO'  Then YNAsk := atNo;
End;

Function YesNoHidden (S: String): tShowSecured;
Begin
  YesNoHidden := ssHidden;
  S := UpString (S);
  If S = 'YES' Then YesNoHidden := ssShow;
  If S = 'NO'  Then YesNoHidden := ssHide;
End;

Function AnyEscNone (S: String): tAbortKey;
Begin
  AnyEscNone := akNone;
  S := UpString (S);
  If S = 'ANY' Then AnyEscNone := akAny;
  If S = 'ESC' Then AnyEscNone := akEsc;
End;

Function AddPath (FileName: PathStr): PathStr;
Begin
  If FileName = '' Then
  Begin
    AddPath := '';
    Exit;
  End;

  AddPath := CompletePath (JustPathName (FileName)) + JustFileName (FileName);
End;

Procedure ChangeParam (Var Str: String; NewValue: String);
Var
  Comment         : String;
  ComPos, Spaces  : Byte;

Begin
  ComPos  := Pos (';', Str);

  If ComPos <> 0
  Then
    Comment := Copy (Str, ComPos, 255)
  Else
  Begin
    Comment := '';
    Spaces := 0;
  End;

  Str := ExtractWord (1, Str, [' ']) + ' ' + NewValue;

  If ComPos <> 0 Then
  If ComPos < Length (Str)
  Then
    Spaces := 1
  Else
    Spaces := ComPos-Length (Str)-1;

  Str := Str + Replicate (' ', Spaces) + Comment;
End;

function DMYtoDate(Day, Month, Year : Integer) : LongInt;
  {-Convert from day, month, year to a julian date}
begin
  if Word(Year) < 100 then begin
    Inc(Year, 1900);
    if Year < Threshold2000 then
      Inc(Year, 100);
  end;

  if (Year = MinYear) and (Month < 3) then
    if Month = 1 then
      DMYtoDate := Pred(Day)
    else
      DMYtoDate := Day+30
  else begin
    if Month > 2 then
      Dec(Month, 3)
    else begin
      Inc(Month, 9);
      Dec(Year);
    end;
    Dec(Year, MinYear);
    DMYtoDate :=
      {$IFDEF FourByteDates}
        ((LongInt(Year div 100)*146097) div 4)+
        ((LongInt(Year mod 100)*1461) div 4)+
      {$ELSE}
        ((LongInt(Year)*1461) div 4)+
      {$ENDIF}
        (((153*Month)+2) div 5)+Day+First2Months;
  end;
end;

function HMStoTime(Hours, Minutes, Seconds : Byte) : LongInt;
  {-Convert Hours, Minutes, Seconds to a Time variable}
var
  T : LongInt;
begin
  Hours := Hours mod HoursInDay;
  T := (LongInt(Hours)*SecondsInHour)+(LongInt(Minutes)*SecondsInMinute)+Seconds;
  HMStoTime := T mod SecondsInDay;
end;

Function HoursDiff (DT1, DT2 : {$IFNDEF WIN32} DOS. {$ENDIF} DateTime): LongInt;
Var
  D1, D2        : DateTimeRec;
  Days, Secs    : LongInt;

Begin
  D1. D := DMYtoDate (DT1. Day, DT1. Month, DT1. Year);
  D2. D := DMYtoDate (DT2. Day, DT2. Month, DT2. Year);

  D1. T := HMStoTime (DT1. Hour, DT1. Min, DT1. Sec);
  D2. T := HMStoTime (DT2. Hour, DT2. Min, DT2. Sec);

  if (D1.D > D2.D) or ((D1.D = D2.D) and (D1.T > D2.T)) then
    ExchangeStructs (D1, D2, SizeOf(DateTimeRec));

  {the difference in days is easy}
  Days := D2.D-D1.D;

  {difference in seconds}
  if D2.T < D1.T then begin
    {subtract one day, add 24 hours}
    Dec(Days);
    Inc(D2.T, SecondsInDay);
  end;

  Secs := D2.T-D1.T;

  HoursDiff := Days * 24 + Trunc (Secs/3600);
End;

Function ValidDate (DT: {$IFNDEF WIN32} DOS. {$ENDIF} DateTime): Boolean;
Const
  DOM: Array [1..12] Of Byte = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

Var
  Valid: Boolean;

Begin
  Valid := True;
  If ((DT. Month < 1) Or (DT. Month > 12)) Then Valid := False;
  If Valid Then If ((DT. Day < 1) Or (DT. Day > DOM [DT. Month])) Then Valid := False;
  If ((Valid) And (DT. Month = 2) And (DT. Day = 29) ) Then
  If ((DT. Year Mod 4) <> 0) Then Valid := False;
  ValidDate := Valid;
End;

Function DefaultName (F, Ext, Dir: PathStr): String;
Var
  T     : PathStr;

Begin
  If Trim (F) = '' Then T := '' Else
  Begin
    T := JustPathName (F);
    If T <> '' Then T := CompletePath (T);
    F := T + JustFileName (F);
    If Pos ('.', Copy (F, 2, 255)) = 0 Then T := F + '.' + Ext Else T := F;
    If Pos ('\', F) = 0 Then T := AddBackSlash (Dir) + T;
  End;

  DefaultName := T;
End;

Function StrPosition (SubStr, Str: String; FromPos: Byte): Byte;
Var
  i, Position, j : Byte;

Begin
  StrPosition := 0;
  If FromPos >= Length (Str) Then Exit;

  For i := FromPos To Length (Str) Do
  If Str [i] = SubStr [1] Then
  Begin
    Position := i;

    For j := 1 To Length (SubStr) Do
    If Str [j+i] <> SubStr [j+1] Then Break;

    If j = Length (SubStr) Then
    Begin
      StrPosition := Position;
      Exit;
    End;

  End;

End;

Function DelChars (Ch: CharSet; S: String): String;
Var
  i : Byte;

Begin
  i := 1;
  While i < Length (S) Do
  If S [i] in Ch Then Delete (S, i, 1) Else Inc (i);
  DelChars := S;
end;

Function InRange (Num: LongInt; Range: String): Boolean;
Var
  S      : String;        { функция определяет, входит ли Num в  }
  Res    : {$IFNDEF OS2}  { string-овый промежуток, заданный     }
           Integer;       { параметром Range ('1-3,5,12-14')     }
           {$ELSE}
           LongInt;
           {$ENDIF}
  MN, CM, R1, R2 : Byte;
  Yesss  : Boolean;

Begin
  If Pos (',', Range) = 0 Then
  Begin
    MN := Pos ('-', Range);
    If MN <> 0 Then
    Begin
      S := Copy (Range, 1, MN-1);
      Val (S, R1, Res);
      CM := Pos ('''', Copy (Range, MN + 1, 255));
      If CM = 0 Then CM := 255 Else CM := CM-MN;
      S := Copy (Range, MN+1, CM);
      Val (S, R2, Res);
      Yesss := Not ((Num < R1) Or (Num > R2));
    End Else
    Begin
      Str (Num, S);
      Yesss := S = Range;
    End;
  End Else
  Begin
    Yesss := False;
    Repeat
      S := Copy (Range, 1, Pos (',', Range) - 1);
      Delete (Range, 1, Length (S) + 1);
      Yesss := Yesss Or InRange (Num, S);
    Until Pos (',', Range) = 0;
    Yesss := Yesss Or InRange (Num, Range);
  End;
  InRange := Yesss;
End;

Function GetLiterals (Str: String; Var Ps1, Ps2: Byte): String;
Var
  S : String;
  i : Byte;

Begin
  If Str [1] = '"' Then i := 1 Else i := 2;
  S := ExtractWord (i, Str, ['"']);
  Ps1 := Pos ('"', Str);
  Ps2 := StrPosition ('"', Str, Ps1) + Length (S) + 1;
  GetLiterals := S;
End;

Function RPos (SubStr, Str: String; StartPos: Byte): Byte;
Var
  i, j : Byte;

Begin
  RPos := 0;
  For i := StartPos DownTo 1 Do
  Begin
    If Str [i] = SubStr [1] Then
    Begin
      For j := 1 To Length (SubStr) Do
      If SubStr [j] <> Str [i-j] Then Continue;
      RPos := i;
      Exit;
    End;
  End;
End;

Function RelativeAddr (S: String; Addr: AddrType): String;
Var
  tmpAddr       : AddrType;

Begin
  S := Trim (S);
  If S [1] = '/' Then S := Copy (S, 2, 255);
  ParseStrAddr (S, tmpAddr);

  With tmpAddr Do
  Begin
    If (Zone = 0) and (Pos (':', S) = 0) Then Zone := Addr. Zone;
    If (Net = 0) and (Pos ('/', S) = 0) Then Net := Addr. Net;
    If (Node = 0) And ((S = '') Or (S [1] = '.')) Then Node := Addr. Node;
    If (Point = 0) And (S = '') Then Point := Addr. Point;
  End;

  RelativeAddr := Addr2Str (tmpAddr);
End;

Procedure GetDateTime (Var cDT: {$IFNDEF WIN32} DOS. {$ELSE} OpCrt. {$ENDIF} DateTime);
Var
  Cargo : {$IFDEF WIN32} Word {$ELSE} SysInt {$ENDIF};

Begin
  GetDate (cDT. Year, cDT. Month, cDT. Day, Cargo);
  GetTime (cDT. Hour, cDT. Min, cDT. Sec, Cargo);
End;

Function CharTrans (S, Source, Dest: String): String;
Var
  i, j : Byte;
  tS   : String;

Begin
  tS := S;

  If (Length (S) > 0) and (Length (Source) > 0) and (Length (Dest) > 0) Then
  Begin
    If Length (Source) < Length (Dest) Then
    {$IFNDEF WIN32}
      Dest [0] := Chr (Length (Source))
    {$ELSE}
      SetLength (Dest, Length (Source))
    {$ENDIF} Else
    If Length (Source) > Length (Dest) Then
    {$IFNDEF WIN32}
      Source [0] := Chr (Length (Dest))
    {$ELSE}
      SetLength (Source, Length (Dest))
    {$ENDIF};

    For i := 1 To Length (Source) Do
    Begin
      j := Pos (Source [i], S);
      If j <> 0 Then tS [j] := Dest [i];
    End;
  End;

  CharTrans := tS;
End;

Function Word2Time (W: Word): String;
Begin
  Word2Time := LeftPadCh (Long2Str (Hi (W)), '0', 2) + ':' + LeftPadCh (Long2Str (Lo (W)), '0', 2);
End;

Function Time2Word (S: String): Word;
Begin
  Time2Word := Str2Long (ExtractWord (1, S, [':'])) * 256 + Str2Long (ExtractWord (2, S, [':']));
End;

Function PackStrTime (Date, Mask: String): LongInt;
Var
  DT : {$IFNDEF WIN32} DOS. {$ENDIF} DateTime;
  L  : LongInt;

Begin
  Date := ReFormatDate (Date, Mask, 'DD-MM-YY');
  FillChar (DT, SizeOf (DT), 0);
  DT. Day   := Str2Long (Copy (Date, 1, 2));
  DT. Month := Str2Long (Copy (Date, 4, 2));
  DT. Year  := 1900+Str2Long (Copy (Date, 7, 2));
  PackTime (DT, L);
  PackStrTime := L;
End;

Function TempFName: String;
Var
  h, m, s, s100 : {$IFNDEF OS2} Word; {$ELSE} LongInt; {$ENDIF}

Begin
  GetTime (h, m, s, s100);
  TempFName := Long2Str (m) + Long2Str (s) + Long2Str (s100);
End;
(*
Procedure InitTextSeek (Var T: Text; Var F: File);
Begin
  FileRec (F). Handle := TextRec (T). Handle;
{$IFDEF OS2}
  FileRec (F). Mode := $A55AD7B3;
{$ELSE}
  FileRec (F). Mode := $D7B3;
{$ENDIF}
  FileRec (F). Recsize := 1;
  TextRec (T). BufPos  := 0;
  TextRec (T). BufEnd  := 0;
End;

Procedure TextSeek (Var T: Text; Var F: File; N: LongInt);
Begin
  Seek (F, N);
  TextRec (T). BufPos := 0;
  TextRec (T). BufEnd := 0;
End;
*)
Function AsciiCode2Str (S: String): String;
Var
  O : String;
  i : Byte;

Begin
  O := '';
  i := 0;

  While i < Length (S) Do
  Begin
    Inc (i);

    If (S [i] = '\') and (i+2 <= Length (S)) and
       (S [i+1] in ['0'..'9', 'A'..'F']) and
       (S [i+2] in ['0'..'9', 'A'..'F']) Then
    Begin
      O := O + Chr (Hex2Byte (Copy (S, i+1, 2)));
      Inc (i, 2);
    End Else
      O := O + S [i];
  End;

  AsciiCode2Str := O;
End;

Var
  PageFile : Text;
  PageOK   : Boolean;

Procedure OpenPageFile (FN: PathStr);
Begin
  Assign (PageFile, FN);
  Reset (PageFile);
  PageOK := IOResult = 0;
End;

Procedure PlayNextString;
Var
  S, S1 : String;
  Freq, Pause : LongInt;

Begin
  If PageOK Then
  If Not EoF (PageFile) Then
  Begin
    ReadLn (PageFile, S);
    S := UpString (Trim (S));
    If S [1] = ';' Then Exit;
    S1 := ExtractWord (1, S, [' ']);
    Freq := 0;

    If S1 = 'TONE' Then
    Begin
      Freq := Str2Long (ExtractWord (2, S, [' ']));
      Pause := Str2Long (ExtractWord (3, S, [' ']));
    End Else
    If S1 = 'WAIT' Then Pause := Str2Long (ExtractWord (2, S, [' '])) Else Exit;

    If Freq <> 0 Then
  {$IFDEF MSDOS}
    Begin
      Sound (Freq);
      Sleep (Pause*10);
      NoSound;
    End
  {$ENDIF}
  {$IFDEF OS2}
    PlaySound (Freq, Pause*10)
  {$ENDIF} Else
  {$IFDEF OS2}
     DosSleep (Pause*10);
  {$ELSE}
     Sleep (Pause*10);
  {$ENDIF}

  End Else
  Begin
  Close (PageFile); Reset (PageFile);
  PageOK := IOResult = 0;
  End;
End;

Procedure ClosePageFile;
Begin
  If PageOK Then Close (PageFile);
  If IOResult <> 0 Then;
End;

{$IFDEF WIN32}
Function Str2Win (S: String): String;
Var
  S1, S2 : PChar;

Begin
  GetMem (S1, 255);
  GetMem (S2, 255);

  StrPCopy (S1, S);
  OemToAnsi (S1, S2);
  Str2Win := S2;

  FreeMem (S1, 255);
  FreeMem (S2, 255);
End;
{$ENDIF}

Procedure SmartChDir (S: PathStr);
Begin
  If (Length (S) > 3) And (S [Length (S)] = '\') Then S := Copy (S, 1, Length (S)-1);
  ChDir (S);
End;

Procedure tmDelay (Ms : Word); Assembler;
Asm
  mov ax, 1000
  mul Ms
  mov cx, dx
  mov dx, ax
  mov ah, 86h
  int 15h
End;

Procedure Pause (Duration: LongInt);
Begin
  {$IFDEF MSDOS} tmDelay {$ENDIF}
  {$IFDEF OS2} DosSleep {$ENDIF}
  {$IFDEF WIN32} Sleep {$ENDIF} (Duration);
End;

{$IFNDEF WIN32}
Procedure SetLength (Var S: String; Len: Byte);
Begin
  S [0] := Chr (Len);
End;
{$ENDIF}

End.
