{$IFDEF MSDOS}
{$O+,F+}
{$ENDIF}
{$I-,B-,X+}

Unit
  tScript;

{*********************************************************}
{*                     TSCRIPT.PAS                       *}
{*                                                       *}
{*  Copyright (c) Konstantin Klyagin, 1995-98,           *}
{*                exspecially for Tornado BBS System     *}
{*                                                       *}
{*********************************************************}

Interface

Uses
{$IFNDEF WIN32}
  DOS,
{$ELSE}
  SysUtils,
  Windows,
  Forms,
  WApro,
{$ENDIF}
{$IFDEF OS2}
  OS2Base,
{$ENDIF}
  Objects,
  tMisc,
  OpCrt,
  tGlob,
  Log,
  Parse,
  Shell,
  Areas,
  Protocol,
  MainComm,
  MainCOvr,
  Resource,
  Avatar,
  TimeTask,
  Users,
  FilesBBS;

Function tExecScript (fName: PathStr): Boolean;
Procedure SetMacro (Vname, Value: String);

Implementation

Type
  tScriptState  = (psVariables, psProgram, psProcedure, psNone);
  tVariableType = (tvString, tvLogical, tvNumber);
  tFileOpenMode = (foOpen, foCreate, foAppend);

  pVariable     = ^tVariable;
  tVariable     = Record
    Name     : String [20];
    VarType  : tVariableType;
    ReadOnly : Boolean;
    Value    : PString;
  End;

  pProcedure    = ^tProcedure;
  tProcedure    = Record
    Name     : String [20];
    Start    : LongInt;
    Text     : PNotSortedCollection;
  End;

  pFile         = ^tFile;
  tFile         = Record
    Number    : Byte;
    Handle    : Text;
    EndOfFile : Boolean;
  End;

  pScriptLabel  = ^tScriptLabel;
  tScriptLabel  = Record
    Name, ProcName : String [20];
    Line           : LongInt;
    IfCount        : Byte;
  End;

Var
  T, Parameter, Par1, Par2 : String;
  L                        : LongInt;
  PF                       : PFile;
  SelNum                   : Word;

Const
  ExprChars = ['A'..'Z', 'a'..'z', '0'..'9', '$', '#', '_'];
  ZeroOne   : Array [Boolean] Of Char = ('0', '1');
  StrBase   : Array [tMsgBase] Of String = ('JAM', 'Squish', 'Hudson', 'Fido');

Function NewVariable (Const S: tVariable): PVariable;
Var
  P     : PVariable;

Begin
  GetMem (P, SizeOf (tVariable));
  P^ := S; NewVariable := P;
End;

Procedure DisposeVariable (P: PVariable);
Begin
  If P <> Nil Then
  Begin
    If P^. Value <> Nil Then DisposeStr (P^. Value);
    FreeMem (P, SizeOf (tVariable));
  End;
End;

Function NewProcedure (Const S: tProcedure): PProcedure;
{$IFNDEF WIN32}
Var
  P     : PProcedure;
{$ENDIF}
Begin
{$IFNDEF WIN32}
  GetMem (P, SizeOf (tProcedure));
  P^ := S; NewProcedure := P;
{$ELSE}
  New (Result);
  Result^ := S;
{$ENDIF}
End;

Procedure DisposeProcedure (P: PProcedure);
Begin
  If P <> Nil Then
  Begin
    If P^. Text <> Nil Then Dispose (P^. Text, Done);
    FreeMem (P, SizeOf (tProcedure));
  End;
End;

Function NewPFile (Const S: tFile): PFile;
Var
  P     : PFile;

Begin
  GetMem (P, SizeOf (tFile));
  P^ := S; NewPFile := P;
End;

Procedure DisposePFile (P: PFile);
Begin
  If P <> Nil Then FreeMem (P, SizeOf (tFile))
End;

Function NewScriptLabel (Const S: TScriptLabel): PScriptLabel;
Var
  P     : PScriptLabel;

Begin
  GetMem (P, SizeOf (TScriptLabel));
  P^ := S; NewScriptLabel := P;
End;

Procedure DisposeScriptLabel (P: PScriptLabel);
Begin
  If P <> Nil Then FreeMem (P, SizeOf (TScriptLabel))
End;

Function StripComment (S: String): String;
Var
  Quotes, i, Position : Byte;
  Comm                : Boolean;

Begin
  If Pos ('/', S) = 0 Then
  Begin
    StripComment := S;
    Exit;
  End;

  Quotes := 0;
  Position := 0;
  Comm := False;

  For i := 1 To Length (S) Do
  If S [i] = '"' Then Inc (Quotes) Else
  If S [i] = '/' Then
  If Comm Then
  Begin
    Position := i-1;
    Break;
  End Else
    If Trunc (Quotes/2) = Quotes/2 Then Comm := True;

  If Position <> 0 Then Delete (S, Position, 255);
  StripComment := S;
End;

Procedure SetMacro (Vname, Value: String);
Var
  Tmp   : String;

Begin
  If Vname = '$LOCA' Then R. Location := Value Else
  If Vname = '$ORGZ' Then R. Organization := Value Else
  If Vname = '$ALAS' Then R. Alias := Value Else
  If Vname = '$PSWD' Then R. Password := Value Else
  If Vname = '$HPHN' Then R. HPhone := Value Else
  If Vname = '$BPHN' Then R. BPhone := Value Else
  If Vname = '$ADR1' Then R. Address1 := Value Else
  If Vname = '$ADR2' Then R. Address2 := Value Else
  If Vname = '$ADR3' Then R. Address3 := Value Else
  If Vname = '$CMNT' Then R. Comment := Value Else
  If Vname = '$FLGS' Then R. Flags := Value Else
  If Vname = '$CALN' Then R. NoCalls := Str2Long (Value) Else
  If Vname = '$DAOB' Then R. BirthDate := Date2Long (ReformatDate (Value, Cnf. DateMask, DefaultDateMask)) Else
  If Vname = '$FDTE' Then R. FirstDate := Date2Long (ReFormatDate (Value, Cnf. DateMask, DefaultDateMask)) Else
  If Vname = '$LDTE' Then R. LastDate := Date2Long (ReFormatDate (Value, Cnf. DateMask, DefaultDateMask)) Else
  If Vname = '$LTME' Then R. LastTime := Time2Word (Value) Else
  If Vname = '$FNUM' Then SetFileArea (Str2Long (Value)) Else
  If Vname = '$MNUM' Then SetMsgArea (Str2Long (Value)) Else
  If Vname = '$FGRN' Then SetFileGroup (Str2Long (Value)) Else
  If Vname = '$MGRN' Then SetMsgGroup (Str2Long (Value)) Else
  If Vname = '$ULDS' Then R. UpLoads := Str2Long (Value) Else
  If Vname = '$DNLS' Then R. DownLoads := Str2Long (Value) Else
  If Vname = '$ULKB' Then R. UpLoadsK := Str2Long (Value) Else
  If Vname = '$DLKB' Then R. DownLoadsK := Str2Long (Value) Else
  If Vname = '$LINS' Then R. Lines := Str2Long (Value) Else
  If Vname = '$LIMK' Then R. DailySize := Str2Long (Value) Else
  If Vname = '$ETME' Then R. TotalTime := Str2Long (Value)*60 + MidSec - EnterTime Else
  If Vname = '$LFKB' Then R. DailySize := Str2Long (Value) + R. TodayK + Trunc (SizeOfAll/1024) Else
  If Vname = '$LANG' Then
  Begin
    If ReadLanguage (Language, DefaultName (LoString (Value), 'LNG', Cnf. LngPath))
    Then R. Lang := Value;
  End Else
  If Vname = '$EMUL' Then
  Begin
    Tmp := UpString (Value);
    If Tmp = 'ANSI' Then R. Emu := teAnsi Else
    If Tmp = 'AVATAR' Then R. Emu := teAvatar Else
    If Tmp = 'TTY' Then R. Emu := teTty;
    SetEmulation;
  End Else
  If Vname = '$SECR' Then
  Begin
    If Str2Long (Value) <> R. Security Then
    Begin
      R. Security := Str2Long (Value);
      SetSecurity;
    End;
  End Else
  If Vname = '$PROT' Then
  Begin
    Tmp := Value;
    SetProtocol (Tmp [1]);
  End;

  UpdateUserMacro;
End;

Function tExecScript (fName: PathStr): Boolean;

Var
  i, j, LineNum, ProcLine, IfCount1  : LongInt;
  F                                  : Text;
  Command, ProcName, S1, S           : String;
  State                              : tScriptState;
  Variables, Procedures, Files,
  ProcText, ScriptParams, ProcStack,
  Labels                             : PNotSortedCollection;
  WC                                 : Byte;
  VarType                            : tVariableType;
  ExecNext, tB, ArrayVar             : Boolean;
  TagFileRec                         : TTagFileRec;

Const
  Finished      : Boolean = False;
  ProcExec      : Boolean = False;
  TagFileNum    : LongInt = 0;
  BufStr        : String = '';

Function StrExpression (S: String; Monolite: Boolean): String; Forward;
Function MathExpression (Var Stroka: String): Boolean; Forward;

Procedure Error (Code: LongInt);
Const
  Msg   : String = 'Unknown error code';

Var
  S     : String;

Begin
  Msg := sm (Code);

  S := 'Script error in ' + Trim (NiceFileName (fName, 30)) + ' (' + Long2Str (LineNum) + '): ' + Msg;
  LogWrite ('!', S);
  S [Pos ('):', S)+2] := '|';
  Message (S);

  Finished := True;
End;

Function GetVar (N: String): PVariable;

Const
  Name : String = '';

  Function Matches (P: PVariable): Boolean;
  Begin
    Matches := P^. Name = Name;
  End;

Begin
  If Length (N) > 20 Then N := Copy (N, 1, 20);
  Name := UpString (N);
  GetVar := Variables^. FirstThat (@Matches);
End;

Function GetValue (Name: String): String;
Var
  P : PString;
  V : PVariable;

Begin
  V := GetVar (Name);
  P := PVariable (V)^. Value;
  If P <> nil Then GetValue := PString (P)^ Else
  If V^. VarType in [tvNumber, tvLogical] Then GetValue := '0' Else GetValue := '';
End;

Function MathExpression (Var Stroka: String): Boolean;

Var
  Success    : Boolean; { true - если вычисления завершены успешно }

Const
  StackSize   = 40; { максимальное число лексем в выражении }
  ElementSize = 23; { максимальное число знаков в лексеме - не меньше !!! }

Type
  SetOfChar = Set Of Char;
  { тип лексемы }
  Token = (number, plus, minus, ast, dvt, lparen, rparen, step);

  { тип элемента стека }
  Element = Record
              TextElement: String [ElementSize];
              TypeElement: Token;
            End;
  { тип стека }
  Maneger = Record
              StackBody : Array [1..StackSize] Of Element;
              StackCount: Byte;
            End;
Const
  Operations: Set Of Token = [plus, minus, ast, dvt, step];

Var
  Stack      : Maneger;   { стек }
  ScanStr    : String;    { разбираеиая строка }
  ScanLength : Word;      { ее длина }
  ScanCount  : Word;      { счетчик символов }
  CH         : Char;      { текущий символ }
  Counter    : Byte;      { счетчик скобок }
  sym        : Token;     { тип лексемы }
  Lexeme                  { текст лексемы }
             : String [ElementSize];

Procedure InitStack;
{    инициализация стека   }
Var
  i : Byte;
Begin
  Success := True;
  Stack. StackCount := 0;
  For i := 1 To StackSize Do Stack. StackBody [i].TextElement := '';
End;

Procedure InStack (S: String; T: Token);
{   включить элемент в стек справа   }
Begin
  If Stack. StackCount = StackSize Then
  Begin
    Error (seExprTooLong);
    Success := False;
    Exit;
  End;

  With Stack Do
  Begin
    Inc (StackCount);
    StackBody [StackCount].TextElement := S;
    StackBody [StackCount].TypeElement := T;
  End;
End;

Procedure FromStack (Var op1, op2, opr: Element; NumElements: Byte);
{ извлечение из стека операндов и кода операции :
     NumElements - сколько операндов,
     op1,op2  - операнды,
     opr      - операция }
Var
  i, j: Byte;
Begin
  With Stack Do
  Begin
    If Counter <= NumElements Then
    Begin
      Error (seExprError);
      Success := False;
      Exit;
    End;

    opr := StackBody [Counter  ];
    op2 := StackBody [Counter - 1];
    If NumElements = 2
    Then
      op1 := StackBody [Counter - 2]
    Else
      op1.TextElement := '0';

    For j := 1 To NumElements Do
    Begin
      For i := Counter To StackCount - 1 Do StackBody [i] := StackBody [i + 1];
      StackBody [StackCount].TextElement := '';
      Dec (StackCount);
      Dec (Counter);
    End;
  End;
End;

Procedure Scan;
{ сканер - дает в sym тип лексемы, а в Lexeme ее текст }
Var
  Check: Boolean;
Begin
  If ScanCount > ScanLength Then Exit;

  Repeat
    CH := ScanStr [ScanCount];
    If CH = ' ' Then Inc (ScanCount);
  Until CH <> ' ';

  Check := True;
  If CH In ['0'..'9'] Then
  Begin   { число }
    sym := number;
    Lexeme := '';

    While CH In ['0'..'9'] Do
    Begin
      If Length (Lexeme) = ElementSize Then
      Begin
        Success := False;
        Error (seExprTooLong);
        Exit;
      End;
      Lexeme := Lexeme + CH;
      Inc (ScanCount);
      If ScanCount > ScanLength Then Exit;
      CH := ScanStr [ScanCount];
    End;

  End Else
    If UpCase (CH) In ExprChars Then
    Begin    { текст }
      Lexeme := '';

      While UpCase (CH) In ExprChars Do
      Begin
        If Length (Lexeme) = ElementSize Then
        Begin
          Success := False;
          Error (seExprTooLong);
          Exit;
        End;

        Lexeme := Lexeme + UpCase (CH);
        Inc (ScanCount);
        If ScanCount > ScanLength Then Break;
        CH := ScanStr [ScanCount];
      End;

      If (GetVar (Lexeme) <> nil) Then
      Begin
        If PVariable (GetVar (Lexeme))^. VarType <> tvNumber Then
        Begin
          Error (seInvalidType);
          Exit;
        End;

        Lexeme := GetValue (Lexeme);
        sym := number;
      End Else
        Check := False;

    End
  Else
    Case CH Of
      '+' :
             Begin
               sym := plus;
               Inc (ScanCount);
             End;
      '-' :
             Begin
               sym := minus;
               Inc (ScanCount);
             End;
      '^' :
             Begin
               sym := step;
               Inc (ScanCount);
             End;
      '*' :
             Begin
               sym := ast;
               Inc (ScanCount);
             End;
      '/',
      ':' :
             Begin
               sym := dvt;
               Inc (ScanCount);
             End;
      '(' :
             Begin
               sym := lparen;
               Inc (ScanCount);
               Inc (Counter);
             End;
      ')' :
             Begin
               sym := rparen;
               Inc (ScanCount);
               Dec (Counter);
             End;
      #0,
      #13 :  ;
    Else
      Check := False;
    End;

  If Not Check Then Error (seUnrecSymb);
  Success := Check;
End;

Procedure Term; Forward;

Procedure Expression;
Var
  pl: Boolean;

Begin
  Term; If Not Success Then Exit;

  While (sym = plus) Or (sym = minus) Do
  Begin
    pl := (sym = plus);
    Scan; If Not Success Then Exit;
    Term; If Not Success Then Exit;

    If pl Then
    Begin
      InStack ('+', plus);
      If Not Success Then Exit;
    End Else
    Begin
      InStack ('-', minus);
      If Not Success Then Exit;
    End;
  End;

End;

Procedure Pwr; Forward;

Procedure Term;
Var
  a: Token;
Begin
  Pwr;
  If Not Success  Then Exit;
  While (sym = ast) Or (sym = dvt) Do  Begin
    a := sym;
    Scan;
    If Not Success  Then Exit;
    Pwr;
    If Not Success  Then Exit;
    Case a Of
      ast : Begin
        InStack ('*', ast);
        If Not Success Then Exit;
      End;
      dvt :
            Begin
              InStack (':', dvt);
              If Not Success Then Exit;
            End;
    End;
  End;
End;

Procedure Factor;

Procedure ExpressionInParens;
Begin
  Scan;
  If Not Success Then Exit;
  Expression;
  If Not Success Then Exit;
  If sym = rparen Then
  Begin
    Scan;
    If Not Success Then Exit;
  End Else
  Begin
    Error (seWrongBrack);
    Success := False;
    Exit;
  End;
End;

Begin
  If sym = number Then
  Begin {--- число ---}
    InStack (Lexeme, number);
    If Not Success  Then Exit;
    Scan;
    If Not Success  Then Exit;
  End Else
  If sym = lparen Then
  Begin {--- выражение в скобках ---}
    ExpressionInParens;
    If Not Success  Then Exit;
  End;
End;

Procedure Pwr;
Begin
  Factor;
  If Not Success  Then Exit;
  While sym = step Do
  Begin
    Scan; If Not Success Then Exit;
    Factor; If Not Success Then Exit;
    InStack ('^', step); If Not Success Then Exit;
  End;
End;

Function Power (a, b: Real): LongInt;
Var
  P: LongInt;

Begin
  P := Trunc (Exp (b * Ln (Abs (a))));
  If (Odd (Round (b)) And (a < 0)) Or ((a < 0) And (Frac (b) <> 0)) Then p := - p;
  Power := p;
End;

Var
  StrOp1, StrOp2, opr   : Element;
  op1, op2              : LongInt;
  i                     : {$IFDEF OS2} LongInt {$ELSE} Integer {$ENDIF};

Begin
  If ConsistsOf (Stroka, ['0'..'9', '-']) Then
  Begin
    MathExpression := True;
    Exit;
  End;

  Success := False;
  MathExpression := False;
  ScanStr := Stroka;
  ScanLength := Length (ScanStr);

  If ScanLength = 0 Then
  Begin
    Error (seExprError);
    Exit;
  End;

  If ScanStr [ScanLength] = '(' Then
  Begin
    Error (seWrongBrack);
    Exit;
  End;

  InitStack;

  ScanCount := 1;
  While ScanCount <> ScanLength Do
  Begin
    If ScanStr [ScanCount] = '(' Then
    If ScanStr [ScanCount + 1] = '-' Then
    Begin
      ScanStr := Copy (ScanStr, 1, ScanCount) + '0' +
      Copy (ScanStr, ScanCount + 1, Length (ScanStr) - ScanCount);
      Inc (ScanLength);
    End;
    Inc (ScanCount);
  End;

  ScanCount := 1;
  Counter := 0; { счетчик скобок }
  CH := ' ';
  Scan;
  If Not Success Then Exit;

  Expression;
  If Not Success Then Exit;
  If Counter <> 0 Then
  Begin
    Error (seWrongBrack);
    Exit;
  End;

  Counter := 1;
  While Stack. StackCount > 1 Do
  Begin
    While Not (Stack. StackBody [Counter].TypeElement In Operations) Do Inc (Counter);
    FromStack (StrOp1, StrOp2, opr, 2);
    If Not Success Then Exit;

    If StrOp1. TextElement = '' Then StrOp1. TextElement := '0';
    Val (StrOp1. TextElement, op1, i);

    If i <> 0 Then
    Begin
      Error (seExprError);
      Exit;
    End;

    Val (StrOp2.TextElement, op2, i);
    If i <> 0 Then
    Begin
      Error (seExprError);
      Exit;
    End;

    Case opr. TypeElement Of
      plus  : Stack. StackBody [Counter].TextElement := Long2Str (op1 + op2);
      minus : Stack. StackBody [Counter].TextElement := Long2Str (op1 - op2);
      ast   : Stack. StackBody [Counter].TextElement := Long2Str (op1 * op2);
      dvt   : If op2 = 0 Then
              Begin
                Error (seZeroDivide);
                Exit;
              End Else
                Stack. StackBody [Counter].TextElement := Long2Str (Trunc (op1 / op2));
      step : Stack. StackBody [Counter].TextElement := Long2Str (Power (op1, op2));
    End;
  End;

  ScanStr := Stack. StackBody [1].TextElement;
  i := 1;
  While ScanStr [i] = ' ' Do Inc (i);
  Stroka := Copy (ScanStr, i, Length (ScanStr) - i + 1);
  MathExpression := True;
End;

Function AddVar (Name: String; vType: tVariableType; Value: String; ReadOnly: Boolean): Boolean;
Var
  V     : tVariable;
  i     : LongInt;

Begin
  AddVar := False;
  For i := 0 To Variables^. Count - 1 Do
    If pVariable (Variables^. At (i))^. Name = Name Then Exit;

  AddVar := True;
  V. Name := Name;
  V. VarType := vType;
  V. Value := NewStr (Value);
  V. ReadOnly := ReadOnly;

  Variables^. Insert (NewVariable (V));
End;

Function StringCompare (S: String): Boolean;
Var
  VarName                       : String [20];
  Right                         : String [80];
  EqCount, MinCount, MaxCount   : Byte;

Begin
  EqCount  := AsciiCount (S, ['='], '"');
  MinCount := AsciiCount (S, ['<'], '"');
  MaxCount := AsciiCount (S, ['>'], '"');

  If (EqCount = 2) Or ((MinCount = 2) And (MaxCount = 2)) Then
  Begin
    If EqCount = 2 Then
    Begin
      VarName := UpString (Trim (ExtractAscii (1, S, ['='], '"')));
      Right   := StrExpression (Trim (ExtractAscii (2, S, ['='], '"')), True);
    End Else
    Begin
      VarName := UpString (Trim (ExtractAscii (1, S, ['<'], '"')));
      Right   := StrExpression (Trim (ExtractAscii (2, S, ['>'], '"')), True);
    End;

    If GetVar (VarName) <> nil Then
    Begin
      If EqCount = 2 Then
        StringCompare := GetValue (VarName) = Right
      Else
        StringCompare := GetValue (VarName) <> Right;
    End Else
      Error (seUnknown);

  End Else
    Error (seExprError);
End;

Function NumberCompare (S: String): Boolean;
Var
  VarName                       : String [20];
  Right                         : LongInt;
  EqCount, MinCount, MaxCount   : Byte;
  Res                           : Boolean;

Begin
  Res := False;
  EqCount := WordCount (S, ['=']);
  MinCount := WordCount (S, ['<']);
  MaxCount := WordCount (S, ['>']);

  VarName := UpString (Trim (ExtractWord (1, S, ['=', '<', '>'])));
  S       := Trim (ExtractWord (2, S, ['=', '<', '>'])); If Not MathExpression (S) Then Exit;
  Right   := Str2Long (S);

  If GetVar (VarName) <> nil Then
  Begin
    If EqCount = 2 Then Res := Str2Long (GetValue (VarName)) = Right;

    If (MinCount = 2) And (MaxCount < 2) Then
      Res := (Str2Long (GetValue (VarName)) < Right) Or Res
    Else If (MaxCount = 2) And (MinCount < 2) Then
      Res := (Str2Long (GetValue (VarName)) > Right) Or Res
    Else If (MaxCount = 2) And (MinCount = 2) Then
      Res := (Str2Long (GetValue (VarName)) <> Right)
    Else If EqCount < 2 Then Error (seExprError);
  End Else
    Error (seUnknown);

  NumberCompare := Res;
End;

Function BoolCompare (S: String): Boolean;
Var
  Token : String [50];

Begin
  BoolCompare := False;
  Token := UpString (ExtractWord (1, S, [' ']));

  If Token = 'NOT' Then
    BoolCompare := GetValue (UpString (ExtractWord (2, S, [' ']))) = '0'
  Else If GetVar (Token) <> nil Then
    BoolCompare := GetValue (Token) = '1'
  Else Error (seUnknown);
End;

Function LogicExpression (SStr: String): Boolean;
Var
  WPos  : Byte;

Const
 IdChars : Set Of Char = ['─','$','0'..'9','_','.','A'..'Z','a'..'z'];

Procedure EvaluateResult (Var S: String);
Var
  R, OldR  : Boolean;
  B, BB, i : Byte;
  S1       : String;
  Oper     : Char;

Begin
  S := DelChars ([' '], S);
  B := WordCount (S, ['|', '&']);
  Oper := 'z';

  For i := 1 To B Do
  Begin
    S1 := ExtractWord (i, S, ['|', '&']);
    If (S1 = '0') Or (S1 = '1') Then Continue;
    WPos := WordPosition (i, S, ['|', '&']);
    Delete (S, WPos, Length (S1));
    Insert (GetValue (Trim (S1)), S, WPos);
  End;

  While Length (S) > 1 Do
  Begin
    If Length (S) >= 3 Then
    Begin
      BB := Str2Long (S [1]);
      B := Str2Long (S [3]);

      Case S [2] Of
        '&' : R := Boolean (B) And Boolean (BB);
        '|' : R := Boolean (B) Or Boolean (BB);
      End;

      Case Oper Of
        '&' : R := OldR And R;
        '|' : R := OldR And R;
      End;
      OldR := R;
      Oper := S [2];

      S := Copy (S, 4, 255);
      S := ZeroOne [R] + S;
    End Else
      Error (seIncorrectParams);
  End;
End;

Procedure CompileStr (Var S: String);
Var
  Rez   : Boolean;
  S1    : String [80];

Begin
  S1 := UpString (ExtractWord (1, S, [' ']));

  If (GetVar (S1) <> nil) Or (S1 = 'NOT') Then
  Begin
    If (GetVar (S1) = nil) Or (PVariable (GetVar (S1))^. VarType = tvLogical) Then
      Rez := BoolCompare (S)
    Else If PVariable (GetVar (S1))^. VarType = tvString Then
      Rez := StringCompare (S)
    Else If PVariable (GetVar (S1))^. VarType = tvNumber Then
      Rez := NumberCompare (S);
  End Else
    Error (seUnknown);

  If Rez Then S := '1' Else S := '0';
End;

Procedure BrackMax (Var Str : String);
Var
  Index, OBr, Cbr : Byte;
  SubStr          : String;

Begin
  OBr := 0; CBr := 0; Index := 1;

  While (CBr = 0) And (Index <= Length(Str)) Do
  Begin
    If Str [Index] = '(' Then OBr := Index Else
    If Str [Index] = ')' Then CBr := Index+1;
    Inc (Index);
  End;

  If (CBr <> 0) And (OBr <> 0) And (CBr > OBr) Then
  Begin
    If (CBr <= Length (Str)) And (Str [Cbr] in IdChars) Then Error (seExprError);
    If (Obr > 1) And (Str [Obr-1] in IdChars) Then Error (seExprError);
    SubStr := Copy (Str, OBr, CBr-OBr);
    Delete (SubStr, 1, 1);
    SetLength (SubStr, Length (SubStr)-1);
    If ConsistsOf (SubStr, ['0', '1', ' ', '|', '&']) Then EvaluateResult (SubStr) Else CompileStr (SubStr);
    If Finished Then Exit;
    Delete (Str, OBr, CBr-OBr);
    Insert (SubStr, Str, Obr);
    BrackMax(Str);
  End Else
  If (CBr = 0) And (OBr = 0) Then EvaluateResult (Str) Else
  If CBr < OBr Then Error (seExprError) Else
  If CBr <> 0 Then Error (seExprError) Else Error (seExprError);
End;

Var
  S1, S2   : String [80];
  S3       : String [3];
  i, WC    : Byte;

Begin
  WC := AsciiCount (SStr, [' '], '"');
  For i := 1 To WC Do
  Begin
    S1 := ExtractAscii (i, SStr, [' '], '"');
    S2 := UpString (S1); S3 := '';

    If S2 = 'AND' Then S3 := '&' Else
    If S2 = 'NOT' Then S3 := S2 Else
    If S2 = 'OR'  Then S3 := '|';

    If S3 <> '' Then
    Begin
      WPos := AsciiPosition (i, SStr, [' '], '"');
      Delete (SStr, WPos, Length (S1));
      Insert (S3, SStr, WPos);
    End;
  End;

  If AsciiCount (SStr, ['('], '"') > 1
  Then
    BrackMax (SStr)
  Else
    CompileStr (SStr);

  LogicExpression := SStr = '1';
End;

Procedure ChangeVar (VarName, Value: String);
Var
  P : PVariable;

Begin
  P := GetVar (VarName);
  DisposeStr (PVariable (P)^. Value);
  PVariable (P)^. Value := NewStr (Value);
End;

Procedure UpdateReservedVars;
Begin
  If (F2Transfer^. Count = 0) and (SizeOfAll > 0)
  Then SelNum := 1 Else SelNum := F2Transfer^. Count;

  ChangeVar ('$TIME', StrTime);
  ChangeVar ('$ETME', Long2Str (Round ((R. TotalTime - MidSec + EnterTime)/60)));
  ChangeVar ('$TTME', Long2Str (Lim. Time));
  ChangeVar ('$OTME', Long2Str (Round ((MidSec - EnterTime)/60)));
  ChangeVar ('$SELK', Long2Str (Round (SizeOfAll/1024)));
  ChangeVar ('$SELN', Long2Str (SelNum));
  ChangeVar ('$ULKB', Long2Str (R. UpLoadsK));
  ChangeVar ('$DLKB', Long2Str (R. DownLoadsK));
  ChangeVar ('$DLTK', Long2Str (R. TodayK));
  ChangeVar ('$ULDS', Long2Str (R. UpLoads));
  ChangeVar ('$DNLS', Long2Str (R. DownLoads));
  UpdateUserMacro;
End;

Function StrExpression (S: String; Monolite: Boolean): String;

Type
  tParserState = (epNone, epString, epCollectExp);

Var
  i             : Byte;
  Res, Expr     : String;
  State         : tParserState;
  StrP          : PString;

Begin
  State := epNone;
  Res := '';
  Expr := '';
  i := 1;

  While i <= Length (S) Do
  Begin
    Case State Of
      epNone     : Case S [i] Of
                     '"'      : State := epString;
                     ' ', '+' : Begin
                                  Inc (i);
                                  Continue;
                                End;
                     ','      : If Monolite Then
                                Begin
                                  Error (seIncorrectParams);
                                  Break;
                                End;
                   Else
                     State := epCollectExp;
                     Continue;
                   End;

      epString     : Case S [i] Of
                       '"' : State := epNone;
                     Else
                       Res := Res + S [i];
                     End;

      epCollectExp : Begin
                       If S [i] In ExprChars Then
                         Expr := Expr + S [i];

                       If Not (S [i] In ExprChars) Or (Length (S) = i) Then
                       Begin
                         Expr := UpString (Expr);

                         If GetVar (Expr) <> Nil Then
                         Begin
                           If (Expr = '$TIME') Or (Expr = '$ETME') Or
                              (Expr = '$OTME') Or (Expr = '$TTME')
                           Then UpdateReservedVars;

                           Res := Res + GetValue (Expr);
                         End Else
                         If Expr [1] = '#' Then
                         Begin
                           Res := Res + Chr (Str2Long (Copy (Expr, 2, 255)));
                           Expr := '';
                           State := epNone;
                           If i < Length (S) Then Continue;
                         End
                         Else Begin
                           Error (seUnknown);
                           Break;
                         End;

                         Expr := '';
                         State := epNone;
                       End;
                     End;
    End;
    Inc (i);
  End;

  StrExpression := Res;
End;

Procedure AddProc (Name: String; Var Text: PNotSortedCollection; LineNum: LongInt);
Var
  V     : TProcedure;
  i     : LongInt;

Begin
  For i := 0 To Procedures^. Count - 1 Do
  If PProcedure (Procedures^. At (i))^. Name = Name Then Exit;

  V. Name := Name;
  V. Text := Text;
  V. Start := LineNum;

  Procedures^. Insert (NewProcedure (V));
End;

(*
Function GetProc (Name: String): PProcedure;
Var
  i : LongInt;

Begin
  GetProc := Nil;
  If Length (Name) > 20 Then Name := Copy (Name, 1, 20);

  For i := 0 To Procedures^. Count - 1 Do
  If PProcedure (Procedures^. At (i))^. Name = Name Then
  Begin
    GetProc := PProcedure (Procedures^. At (i));
    Exit;
  End;
End;
*)

Function GetProc (N: String): PProcedure;

Const
  Name : String = '';

  Function Matches (P: PVariable): Boolean;
  Begin
    Matches := P^. Name = Name;
  End;

Begin
  If Length (N) > 20 Then N := Copy (N, 1, 20);
  Name := UpString (N);
  GetProc := Procedures^. FirstThat (@Matches);
End;

Function GetPFileNum (L: LongInt): PFile;
Var
  i      : LongInt;

Begin
  For i := 0 To Files^. Count - 1 Do
  If PFile (Files^. At (i))^. Number = L Then
  Begin
    GetPFileNum := Files^. At (i);
    Exit;
  End;
End;

Procedure ClosePFile (N: LongInt);
Var
  i      : LongInt;

Begin
  For i := 0 To Files^. Count - 1 Do
  If PFile (Files^. At (i))^. Number = N Then
  Begin
    Close (PFile (Files^. At (i))^. Handle);
    If IOResult <> 0 Then;
    DisposePFile (Files^. At (i));
    Files^. AtDelete (i);
    Exit;
  End;
End;

Function fFileOpen (L: LongInt; T: PathStr; Mode: tFileOpenMode): Boolean;
Var
  FileRec                       : PFile;

Begin
  New (FileRec);

  With FileRec^ Do
  Begin
    Number := L;
    EndOfFile := False;
    Assign (Handle, T);

    Case Mode Of
      foCreate : ReWrite (Handle);
      foOpen   : Begin
                   ReSet (Handle);
                   EndOfFile := IOResult <> 0;
                 End;
      foAppend : Begin
                   Append (Handle);
                   If IOResult <> 0 Then ReWrite (Handle);
                 End;
    End;

    L := IOResult;
  End;

  If L = 0 Then Files^. Insert (FileRec);
  fFileOpen := L = 0;
End;

Function GetEOF (L: LongInt): Boolean;
Begin
  GetEOF := GetPFileNum (L)^. EndOfFile Or EoF (PFile (GetPFileNum (L))^. Handle);
End;

Procedure InitReservedVars;
Begin
  AddVar ('$PROD', tvString, NameVer, True);
  AddVar ('$NAME', tvString, R. Name, True);
  AddVar ('$BAUD', tvNumber, Long2Str (GetConnectSpeed), True);
  AddVar ('$USRS', tvNumber, Long2Str (UsersNum), True);
  AddVar ('$LOCA', tvString, R. Location, False);
  AddVar ('$ORGZ', tvString, R. Organization, False);
  AddVar ('$DAOB', tvString, ReFormatDate (Long2Date (R. BirthDate), DefaultDateMask, Cnf. DateMask), False);
  AddVar ('$ALAS', tvString, R. Alias, False);
  AddVar ('$PSWD', tvString, R. Password, False);
  AddVar ('$HPHN', tvString, R. HPhone, False);
  AddVar ('$BPHN', tvString, R. BPhone, False);
  AddVar ('$ADR1', tvString, R. Address1, False);
  AddVar ('$ADR2', tvString, R. Address2, False);
  AddVar ('$ADR3', tvString, R. Address3, False);
  AddVar ('$CMNT', tvString, R. Comment, False);
  AddVar ('$SECR', tvNumber, Long2Str (R. Security), False);
  AddVar ('$CALN', tvNumber, Long2Str (R. NoCalls), False);
  AddVar ('$FLGS', tvString, R. Flags, False);
  AddVar ('$BBSN', tvString, Cnf. BbsName, True);
  AddVar ('$SYSO', tvString, Cnf. SysOp, True);
  AddVar ('$LDTE', tvString, ReFormatDate (Long2Date (R. LastDate), DefaultDateMask, Cnf. DateMask), False);
  AddVar ('$LTME', tvString, Word2Time (R. LastTime), False);
  AddVar ('$FDTE', tvString, ReFormatDate (Long2Date (R. FirstDate), DefaultDateMask, Cnf. DateMask), False);
  AddVar ('$DATE', tvString, ReFormatDate (StrDate, 'DD-MM-YYYY', Cnf. DateMask), False);
  AddVar ('$TIME', tvString, StrTime, False);
  AddVar ('$FARE', tvString, FileArea. Name, True);
  AddVar ('$FGRP', tvString, FileGroup. Name, True);
  AddVar ('$FNUM', tvNumber, Long2Str (R. FileArea), False);
  AddVar ('$FGRN', tvNumber, Long2Str (R. FileGroup), False);
  AddVar ('$MARE', tvString, MsgArea. Name, True);
  AddVar ('$MGRP', tvString, MsgGroup. Name, True);
  AddVar ('$MNUM', tvNumber, Long2Str (R. MsgArea), False);
  AddVar ('$MGRN', tvNumber, Long2Str (R. MsgGroup), False);
  AddVar ('$ULDS', tvNumber, Long2Str (R. UpLoads), False);
  AddVar ('$DNLS', tvNumber, Long2Str (R. DownLoads), False);
  AddVar ('$ULKB', tvNumber, Long2Str (R. UpLoadsK), False);
  AddVar ('$DLKB', tvNumber, Long2Str (R. DownLoadsK), False);
  AddVar ('$PROT', tvString, ProtocolDef. Name, False);
  AddVar ('$LINS', tvNumber, Long2Str (R. Lines), False);
  AddVar ('$LANG', tvString, lang (laName), False);
  AddVar ('$EMUL', tvString, EmuName [R. Emu], False);
  AddVar ('$LIMK', tvNumber, Long2Str (R. DailySize), False);
  AddVar ('$ETME', tvNumber, Long2Str (Round ((R. TotalTime - MidSec + EnterTime)/60)), False);
  AddVar ('$TTME', tvNumber, Long2Str (Lim. Time), True);
  AddVar ('$FNAM', tvString, ExtractWord (1, R. Name, [' ']), True);
  AddVar ('$LNAM', tvString, Copy (R. Name, Pos (' ', R. Name)+1, 255), True);
  AddVar ('$LFKB', tvNumber, Long2Str (R. DailySize - R. TodayK - Trunc (SizeOfAll/1024)), False);
  AddVar ('$OTME', tvNumber, Long2Str (Round ((MidSec - EnterTime)/60)), True);
  AddVar ('$DLTK', tvNumber, Long2Str (R. TodayK), True);
  AddVar ('$MSGP', tvNumber, Long2Str (R. MsgsPosted), True);
  AddVar ('$SELK', tvNumber, Long2Str (Round (SizeOfAll/1024)), True);

  AddVar ('$FAGR', tvNumber, Long2Str (fAreasGroup), True);
  AddVar ('$FAMT', tvNumber, Long2Str (fAreasAmount), True);
  AddVar ('$FGAM', tvNumber, Long2Str (ffGroupsAmount), True);
  AddVar ('$MAGR', tvNumber, Long2Str (mAreasGroup), True);
  AddVar ('$MAMT', tvNumber, Long2Str (mAreasAmount), True);
  AddVar ('$MGAM', tvNumber, Long2Str (mmGroupsAmount), True);

  If (F2Transfer^. Count = 0) and (SizeOfAll > 0)
  Then SelNum := 1 Else SelNum := F2Transfer^. Count;

  AddVar ('$SELN', tvNumber, Long2Str (SelNum), True);

  AddVar ('ARGCOUNT', tvNumber, Long2Str (ScriptParams^. Count), True);

  AddVar ('CFGPATH', tvString, Cnf. Path, True);
  AddVar ('CFGPORT', tvString,
    {$IFNDEF OS2} 'COM' + Long2Str ( {$ENDIF} Cnf. ComPort
    {$IFNDEF OS2} ) {$ENDIF}, True);
  AddVar ('CFGLOG', tvString, Cnf. LogFile, True);
  AddVar ('CFGCHATLOG', tvString, Cnf. ChatLog, True);
  AddVar ('CFGTRCLOG', tvString, Cnf. TRCLog, True);
  AddVar ('CFGTEMPDIR', tvString, Cnf. TempDir, True);
  AddVar ('CFGFLAGSDIR', tvString, Cnf. FlagsDir, True);
  AddVar ('CFGDOORDIR', tvString, Cnf. DoorInfoDir, True);
  AddVar ('CFGLOGO', tvString, Cnf. Logo, True);
  AddVar ('CFGSAVETAG', tvString, Cnf. SaveTagPath, True);
  AddVar ('CFGPRIVUL', tvString, Cnf. PrivUploadsDir, True);
  AddVar ('CFGLANGDIR', tvString, Cnf. LngPath, True);
  AddVar ('CFGLANGTXTPATH', tvString, lang (laTxtFiles), True);
  AddVar ('CFGLANGMNUPATH', tvString, lang (laMenus), True);
  AddVar ('CFGLANGNEWS', tvString, lang (laNews), True);

  AddVar ('MAADDRESS', tvString, Addr2Str (MsgArea. Address), True);
  AddVar ('MAORIGIN', tvString, MsgArea. Origin, True);
  AddVar ('MABASE', tvString, StrBase [MsgArea. BaseType], True);
  AddVar ('MAPATH', tvString, MsgArea. BasePath, True);
  AddVar ('MABOARD', tvNumber, Long2Str (MsgArea. BoardNum), True);

  AddVar ('FADLPATH', tvString, FileArea. DLPath, True);
  AddVar ('FAULPATH', tvString, FileArea. ULPath, True);
  AddVar ('FAFILELIST', tvString, FileArea. FileList, True);

  AddVar ('KEYB_UP', tvString, kbUp, True);
  AddVar ('KEYB_DOWN', tvString, kbDown, True);
  AddVar ('KEYB_RIGHT', tvString, kbRight, True);
  AddVar ('KEYB_LEFT', tvString, kbLeft, True);
  AddVar ('KEYB_HOME', tvString, kbHome, True);
  AddVar ('KEYB_END', tvString, kbEnd, True);
End;

Function GetScriptString (Var S: String): Boolean;
Var
  WC : Byte;

Begin
  GetScriptString := True;

  While True Do
  Begin

    If BufStr = '' Then
    Begin
      Inc (LineNum);

      If ProcExec Then
      Begin
        If ProcLine < ProcText^. Count Then
        Begin
          S := PString (ProcText^. At (ProcLine))^;
          Inc (ProcLine);
        End;
      End Else
      Begin
        ReadLn (F, S);
        S := PlaceSubStr (S, #9, '    ');
      End;

      If EoF (F) Then
      Begin
        GetScriptString := False;
        Exit;
      End;

    End;

    S := Trim (StripComment (S));
    If S = '' Then Continue;

    If S [Length (S)] = ';' Then S := Copy (S, 1, Length (S)-1);
    WC := AsciiCount (S, [';'], '"');

    If (WC > 1) Or (BufStr <> '') Then
    Begin
      If BufStr = '' Then BufStr := S;
      S := ExtractAscii (1, BufStr, [';'], '"');
      Delete (BufStr, 1, Length (S)-AsciiPosition (2, S, [';'], '"') + 1);
    End;

    S1 := UpString (Trim (S));
    If S <> '' Then Break;
  End;
End;

Procedure ScanForLabels;
Var
  S      : String;
  L      : TScriptLabel;

Begin
  IfCount1 := 0;
  LineNum := 0;
  State := psNone;
  ProcExec := False;

  While Not EoF (F) Do
  Begin
    If Not GetScriptString (S) Then Continue;
    S1 := ExtractWord (1, S1, [' ']);

    Case State Of
      psNone    : If S1 = 'PROGRAM' Then State := psProgram;

      psProgram : Begin
                    If S1 = 'IF' Then Inc (IfCount1) Else
                    If S1 = 'END' Then
                    Begin
                      If (State = psProgram) and (IfCount1 > 0)
                      Then Dec (IfCount1) Else State := psNone;
                    End Else
                    If S1 [Length (S1)] = ':' Then
                    Begin
                      L. Name := Copy (S1, 1, Length (S1)-1);
                      L. Line := LineNum;
                      L. IfCount := IfCount1;
                      Labels^. Insert (NewScriptLabel (L));
                    End;
                  End;
    End;
  End;
End;

Procedure GoToLabel (LabelName: String);
Var
  S      : String;
  P      : PScriptLabel;

Const
  Name : String = '';

Function Matches (P: PScriptLabel): Boolean;
Begin
  Matches := P^. Name = Name;
End;

Begin
  IfCount1 := 0;

  If Not ProcExec Then
  Begin
    P := Nil;
    Name := LabelName;
    P := Labels^. FirstThat (@Matches);

    If P <> Nil Then
    Begin
      i := 0;
      Close (F);
      Reset (F);
      IfCount1 := P^. IfCount;

      While (i < P^. Line) And Not EoF (F) Do
      Begin
        ReadLn (F, S);
        Inc (i);
      End;

      LineNum := P^. Line;
    End Else
      Error (seLabelNotFound);

    Exit;
  End Else
  Begin
    LineNum := GetProc (ProcName)^. Start;
    ProcLine := 0;
    State := psProgram;
  End;

  While Not EoF (F) And Not Finished Do
  Begin
    If Not GetScriptString (S) Then Continue;
    S1 := ExtractWord (1, S1, [' ']);

    Case State Of
      psNone    : If S1 = 'PROGRAM' Then State := psProgram;

      psProgram : Begin
                    If S1 = 'IF' Then Inc (IfCount1) Else
                    If S1 = 'END' Then
                    Begin
                      If (State = psProgram) and (IfCount1 > 0) Then Dec (IfCount1) Else
                      If ProcExec Then Error (seLabelNotFound) Else State := psNone;
                    End Else
                    If (S1 [Length (S1)] = ':') And (Copy (S1, 1, Length
                       (S1)-1) = LabelName) Then Break;
                  End;
    End;
  End;
End;

Procedure ParseArray;
Var
  i : Byte;

Const
  Delims : Set Of Char = ['(', ')', ' ', ',', '='];

Begin
  WC := AsciiCount (S, Delims, '"');

  For i := 1 To WC Do
  Begin
    T := ExtractAscii (i, S, Delims, '"');
    L := Length (T);
    j := Pos ('#', T);

    If j <> 0 Then
    Begin
      S1 := Copy (T, j+1, 255);

      If S1 [1] in ['0'..'9'] Then Continue;
      If Not MathExpression (S1) Then
      Begin
        Error (seInvalidIndex);
        Exit;
      End;

      T := Copy (T, 1, j);
      j := AsciiPosition (i, S, Delims, '"');
      Delete (S, j, L); T := T+S1; Insert (T, S, j);
    End;
  End;
End;

Procedure SkipLogic;
Var
  IfCount : LongInt;

Begin
  IfCount := 0;

  While Not EoF (F) Do
  Begin
    If Not GetScriptString (S) Then Continue;
    S1 := ExtractWord (1, S1, [' ']);

    If S1 = 'IF' Then Inc (IfCount) Else
    If S1 = 'END' Then
    Begin
      If IfCount > 0 Then Dec (IfCount) Else Break;
    End Else
    If S1 = 'ELSE' Then
    If IfCount = 0 Then Break;
  End;
End;

Procedure UpdateConnected (Vname: String);
Begin
  If Vname = '$FNUM' Then
  Begin
    ChangeVar ('$FARE', FileArea. Name);
    ChangeVar ('MAADDRESS', Addr2Str (MsgArea. Address));
    ChangeVar ('MAORIGIN', MsgArea. Origin);
    ChangeVar ('MABASE', StrBase [MsgArea. BaseType]);
    ChangeVar ('MAPATH', MsgArea. BasePath);
    ChangeVar ('MABOARD', Long2Str (MsgArea. BoardNum));
  End Else
  If Vname = '$MNUM' Then
  Begin
    ChangeVar ('$MARE', MsgArea. Name);
    ChangeVar ('FADLPATH', FileArea. DLPath);
    ChangeVar ('FAULPATH', FileArea. ULPath);
    ChangeVar ('FAFILELIST', FileArea. FileList);
  End Else
  If Vname = '$FGRN' Then
  Begin
    ChangeVar ('$FGRP', FileGroup. Name);
    ChangeVar ('$FAGR', Long2Str (fAreasGroup));
  End Else
  If Vname = '$MGRN' Then
  Begin
    ChangeVar ('$MGRP', MsgGroup. Name);
    ChangeVar ('$MAGR', Long2Str (mAreasGroup));
  End Else
  If Vname = '$SECR' Then
  Begin
    ChangeVar ('$LFKB', Long2Str (R. DailySize - (R. TodayK + Trunc (SizeOfAll/1024))));
    ChangeVar ('$LIMK', Long2Str (R. DailySize));
  End Else
  If Vname = '$PROT' Then
    ChangeVar ('$PROT', ProtocolDef. Name);
End;

Const
  CompareDelims         : Set Of Char = ['<', '>', '='];

Label
  Prog,
  Log;

Begin
  tExecScript := False;
  ScriptParams := New (PNotSortedCollection, Init (5, 1));

  For i := 2 To WordCount (fName, [' '])
  Do ScriptParams^. Insert (NewStr (ExtractWord (i, fName, [' '])));

  fName := DefaultName (ExtractWord (1, fName, [' ']), 'trs', lang (laTxtFiles));

  Assign (F, fName); Reset (F);

  If IOResult <> 0 Then
  Begin
    ScriptParams^. FreeAll;
    ScriptParams^. DeleteAll;
    Dispose (ScriptParams, Done);
    Exit;
  End;

  Variables := New (PNotSortedCollection, Init (10, 10));
  Procedures := New (PNotSortedCollection, Init (10, 10));
  Files := New (PNotSortedCollection, Init (10, 10));
  Labels := New (PNotSortedCollection, Init (10, 10));

  SetDebugFile (fName);
  Finished := False;

  InitReservedVars;
  ProcStack := New (PNotSortedCollection, Init (10, 10));

  ScanForLabels;
  Close (F); ReSet (F);

  State := psNone;
  LineNum := 0;
  IfCount1 := 0;

  While Not (EoF (F) Or Finished) Do
  Begin
  {$IFDEF WIN32}
    If Application. Terminated Then Exit;
  {$ENDIF}
    If Not GetScriptString (S) Then Continue;
    If (S1 [Length (S1)] = ':') and (State <> psProcedure) Then Continue;

    If S1 = 'END' Then
    Case State Of
         psNone : Begin
                    Error (seUnexpEnd);
                    Break;
                  End;

    psVariables : Begin
                    State := psNone;
                    Continue;
                  End;

      psProgram : Begin
                    If IfCount1 = 0 Then
                    If ProcExec Then
                    Begin
                      S := PString (ProcStack^. At (ProcStack^. Count-1))^;
                      LineNum := Str2Long (ExtractWord (2, S, ['`']));
                      ProcLine := Str2Long (ExtractWord (3, S, ['`']));
                      IfCount1 := Str2Long (ExtractWord (4, S, ['`']));
                      ProcName := Copy (S, 1, Pos ('`', S)-1);
                      BufStr := Copy (S, WordPosition (4, S, ['`'])+2, 255);
                      If ProcStack^. Count > 1 Then ProcText := GetProc (ProcName)^. Text;
                      ProcStack^. AtFree (ProcStack^. Count-1);
                      If ProcStack^. Count = 0 Then ProcExec := False;
                    End Else
                      State := psNone
                    Else
                      Dec (IfCount1);

                    Continue;
                  End;

    psProcedure : Begin
                    ProcText^. Insert (NewStr (S));
                    If IfCount1 > 0 Then Dec (IfCount1) Else
                    Begin
                      State := psNone;
                      AddProc (ProcName, ProcText, ProcLine);
                    End;

                    Continue;
                  End;
    End;

    Case State Of
      psNone      : Begin
        If S1 = 'VARIABLES' Then State := psVariables Else
        If S1 = 'PROGRAM' Then State := psProgram Else
        If Copy (S1, 1, 10) = 'PROCEDURE ' Then
        Begin
          ProcName := Trim (Copy (S1, 11, 255));
          ProcLine := LineNum;
          ProcText := New (PNotSortedCollection, Init (5, 5));
          State := psProcedure;
        End Else
          Error (seUnknown);
      End;

      psProcedure : Begin
                      If ExtractWord (1, S1, [' ']) = 'IF' Then Inc (IfCount1);
                      ProcText^. Insert (NewStr (S));
                    End;

      psVariables : Begin
                      If Pos (':', S) = 0 Then
                      Begin
                        Error (seColonMissing);
                        Break;
                      End;

                      S1 := Trim (ExtractWord (1, S1, [':']));
                      T  := Trim (UpString (ExtractWord (2, S, [':'])));
                      WC := WordCount (S, [',']);
                      ArrayVar := False;

                      If WordCount (T, [' ']) > 1 Then
                      If ExtractWord (2, T, [' ']) = 'ARRAY' Then
                      Begin
                        T := ExtractWord (1, T, [' ']);
                        ArrayVar := True;
                      End;

                      If T = 'STRING'  Then VarType := tvString Else
                      If T = 'LOGICAL' Then VarType := tvLogical Else
                      If T = 'NUMBER'  Then VarType := tvNumber Else
                      Error (seUnknown);

                      If ArrayVar Then
                      Begin
                        L := Str2Long (ExtractWord (2, S, ['[', ']']));
                        For i := 1 To WC Do
                        For j := 1 To L Do
                      {$IFNDEF WIN32}
                        If MemAvail > 40000 Then
                      {$ENDIF}
                          AddVar (Trim (ExtractWord (i, S1, [','])) + '#' + Long2Str (j), VarType, '', False)
                      {$IFNDEF WIN32}
                        Else Break;
                      {$ENDIF}

                      End Else
                        For i := 1 To WC Do
                        If Not AddVar (Trim (ExtractWord (i, S1, [','])), VarType, '', False)
                        Then Error (seDuplcate);
                    End;

      psProgram   : Begin
                      If S [1] = '&' Then S := StrExpression (Copy (S, 2, 255), False);
                      If Pos ('#', S) <> 0 Then ParseArray;

                      Command := UpString (ExtractWord (1, S, [' ', '(', ')', '=']));

                      If Command = 'IF' Then
                      Begin
                        S := Trim (Copy (Trim (S), 3, 255));
                        j := AsciiPosition (1, S, CompareDelims, '"');

                        While j <= Length (S) Do
                        Begin
                          i := j;
                          While (S [j] in CompareDelims) and (j <= Length (S)) Do Inc (j);

                          If i <> j Then
                          Begin
                            If Not (S [j] in [' ', '"']) Then Insert (' ', S, j);
                            If Not (S [i-1] in [' ', '"']) Then Insert (' ', S, i);
                          End;

                          Inc (j);
                        End;

                        ExecNext := LogicExpression (S);
                        If Finished Then Break;
                        If Not ExecNext Then SkipLogic;
                        If S1 <> 'END' Then Inc (IfCount1);
                      End
                      Else If Command = 'ELSE' Then
                      Begin
                        If IfCount1 = 0 Then Error (seUnknown);
                        SkipLogic;
                        Dec (IfCount1);
                      End
                      Else If Command = 'FILEDISPLAY' Then
                      Begin
                        S := ExtractAscii (2, S, ['(', ')'], '"');
                        EmuDispFile (StrExpression (Trim (S), True));
                      End
                      Else If Command = 'WRITE' Then
                      Begin
                        ComWrite (StrExpression
                          (Trim (ExtractAscii (2, S,
                          ['(', ')'], '"')), False), $07);
                      End
                      Else If Command = 'WRITELN' Then
                      Begin
                        TimeSlice;
                        ComWrite (StrExpression
                          (Trim (ExtractAscii (2, S,
                          ['(', ')'], '"')), False) + #13#10, $07);
                      End
                      (*
                      Else If Command = 'CLEARWINDOW' Then
                      Begin
                        Parameter := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));

                        Par1 := Trim (ExtractAscii (1, Parameter, [','], '"'));
                        Par2 := Trim (ExtractAscii (2, Parameter, [','], '"'));
                        Par3 := Trim (ExtractAscii (3, Parameter, [','], '"'));
                        Par4 := Trim (ExtractAscii (4, Parameter, [','], '"'));

                        {$B+}
                        If Not MathExpression (Par1) Or
                           Not MathExpression (Par2) Or
                           Not MathExpression (Par3) Or
                           Not MathExpression (Par4) Then
                        {$B-} Error (5);

                        L1 := Str2Long (Par1); L2 := Str2Long (Par2);
                        L3 := Str2Long (Par3); L4 := Str2Long (Par4);

                        Case R. Emu Of
                          teAvatar : ComWrite (AvtClearWindow (L1, L2, L3, L4), 0);
                          teAnsi   : ;
                          teTty    : ;
                        End;

                      End
                      *)
                      Else If Command = 'SETCURSORCOORD' Then
                      Begin
                        Parameter := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));

                        Par1 := Trim (ExtractAscii (1, Parameter, [','], '"'));
                        Par2 := Trim (ExtractAscii (2, Parameter, [','], '"'));

                        {$B+}
                        If Not MathExpression (Par1) Or
                           Not MathExpression (Par2) Then
                        {$B-} Error (seIncorrectParams);

                        ComWrite (EmuGoToXY (Str2Long (Par2), Str2Long (Par1)), $07);
                      End
                      Else If Command = 'SETCOLOR' Then
                      Begin
                        Parameter := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));
                        Par1 := Trim (ExtractAscii (1, Parameter, [','], '"'));
                        Par2 := Trim (ExtractAscii (2, Parameter, [','], '"'));

                        If Not MathExpression (Par1) Or
                           Not MathExpression (Par2)
                        Then
                          Error (seIncorrectParams)
                        Else
                          ComWrite (EmuColor (Str2Long (Par1)*16+Str2Long (Par2)), 0);
                      End
                      Else If Command = 'MESSAGE'
                      Then Message (StrExpression (Trim (ExtractAscii (2, S, ['(', ')'], '"')), False))
                      Else If Command = 'CLEAR' Then Cls
                      Else If Command = 'HANGUP' Then NormExit
                      Else If Command = 'READVAR' Then
                      Begin
                        Parameter := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));
                        T := Trim (ExtractAscii (1, Parameter, [','], '"'));
                        Par1 := Trim (ExtractAscii (2, Parameter, [','], '"'));

                        If Not MathExpression (Par1) Or (GetVar (T) = Nil) Then Error (seIncorrectParams) Else
                        Begin
                          S1 := GetValue (T);
                          ComReadLn (S1, Str2Long (Par1), $02);
                          ChangeVar (T, S1);
                        End;
                      End
                      Else If Command = 'GETARG' Then
                      Begin
                        Parameter := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));
                        Par1 := Trim (ExtractAscii (1, Parameter, [','], '"'));
                        T := Trim (ExtractAscii (2, Parameter, [','], '"'));

                        If Not MathExpression (Par1) Or (GetVar (T) = Nil) Or
                           (GetVar (T)^. VarType <> tvString) Then Error (seIncorrectParams) Else
                        Begin
                          L := Str2Long (Par1);
                          If L <= ScriptParams^. Count Then
                          Begin
                            S1 := PString (ScriptParams^. At (L-1))^;
                            ChangeVar (T, S1);
                          End;
                        End;
                      End
                      Else If Command = 'RANDOM' Then
                      Begin
                        Parameter := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));
                        S1 := Trim (ExtractAscii (1, Parameter, [','], '"'));
                        T := Trim (ExtractAscii (2, Parameter, [','], '"'));

                        If Not MathExpression (S1) Or (GetVar (T) = Nil)
                           Or (GetVar (T)^. VarType <> tvNumber)
                        Then Error (seIncorrectParams)
                        Else ChangeVar (T, Long2Str (Random (Str2Long (S1))+1));
                      End
                      Else If Command = 'READKEY' Then
                      Begin
                        T := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));
                        If GetVar (T) = Nil Then Error (seIncorrectParams) Else ChangeVar (T, ComReadKey);
                      End
                      Else If Command = 'FILESIZE' Then
                      Begin
                        Parameter := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));
                        Par1 := StrExpression (Trim (ExtractAscii (1, Parameter, [','], '"')), True);
                        Par2 := Trim (ExtractAscii (2, Parameter, [','], '"'));

                        If (GetVar (Par2) = Nil) Or (GetVar (Par2)^. VarType <> tvNumber)
                        Then Error (seIncorrectParams)
                        Else ChangeVar (Par2, Long2Str (gFileSize (Par1)));
                      End
                      Else If Command = 'KEYPRESSED' Then
                      Begin
                        T := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));

                        If (GetVar (T) = Nil) Or (PVariable (GetVar (T))^. VarType <> tvLogical)
                        Then Error (seIncorrectParams) Else
                        Begin
                          S1 := ZeroOne [Incoming];
                          ChangeVar (T, S1);
                          If Random (5) < 4 Then Clock2;
                        {$IFDEF WIN32}
                          If Application. Terminated Then Break;
                        {$ENDIF}
                        End;
                      End
                      Else If Command = 'YESNO' Then
                      Begin
                        T := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));

                        If (GetVar (T) = Nil) Or (PVariable (GetVar (T))^. VarType <> tvLogical)
                        Then Error (seIncorrectParams)
                        Else
                        Begin
                          S1 := ZeroOne [Query ('', True, 0)];
                          ChangeVar (T, S1);
                        End;
                      End
                      Else If Command = 'NOYES' Then
                      Begin
                        T := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));

                        If (GetVar (T) = Nil) Or (PVariable (GetVar (T))^. VarType <> tvLogical)
                        Then Error (seIncorrectParams)
                        Else
                        Begin
                          S1 := ZeroOne [Query ('', False, 0)];
                          ChangeVar (T, S1);
                        End;
                      End
                      Else If Command = 'FILEOPEN' Then
                      Begin
                        TimeSlice;
                        Parameter := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));

                        If Not fFileOpen (Str2Long (Trim (ExtractAscii (1,
                           Parameter, [','], '"'))), StrExpression (Trim (
                           ExtractAscii (2, Parameter, [','], '"')), True),
                           foOpen) Then
                        Error (seFileOpenErr);

                      End
                      Else If Command = 'FILEAPPEND' Then
                      Begin
                        TimeSlice;
                        Parameter := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));

                        If Not fFileOpen (Str2Long (Trim (ExtractAscii
                                         (1, Parameter, [','], '"'))),
                                         StrExpression (Trim (ExtractAscii
                                         (2, Parameter, [','], '"')), True),
                                         foAppend)
                        Then Error (seFileOpenErr);

                      End
                      Else If Command = 'FILECREATE' Then
                      Begin
                        Parameter := UpString (Trim (ExtractAscii (2, S, ['(', ')'], '"')));

                        If Not fFileOpen (Str2Long (Trim (ExtractAscii
                                         (1, Parameter, [','], '"'))),
                                         StrExpression (Trim (ExtractAscii
                                         (2, Parameter, [','], '"')), True),
                                         foCreate)
                        Then Error (seFileOpenErr);

                      End
                      Else If Command = 'FILECLOSE' Then
                      Begin
                        ClosePFile (Str2Long (Trim (ExtractWord (1, ExtractWord (2, S, ['(', ')']), [',']))));
                      End
                      Else If Command = 'FILEGETEOF' Then
                      Begin
                        Parameter := UpString (Trim (ExtractWord (2, S, ['(', ')'])));
                        T := Trim (ExtractWord (2, Parameter, [',']));
                        L := Str2Long (Trim (ExtractWord (1, Parameter, [','])));

                        If (GetVar (T) = nil) Or (GetVar (T)^. VarType <> tvLogical)
                        Then Error (seIncorrectParams)
                        Else ChangeVar (T, Long2Str (Byte (GetEoF (L))));
                      End
                      Else If Command = 'FILEREADSTRING' Then
                      Begin
                        Parameter := UpString (Trim (ExtractWord (2, S, ['(', ')'])));
                        T := Trim (ExtractWord (2, Parameter, [',']));
                        L := Str2Long (Trim (ExtractWord (1, Parameter, [','])));

                        If (GetVar (T) = nil) Or (GetVar (T)^. VarType <> tvString) Then Error (seIncorrectParams) Else
                        Begin
                          If Not GetPFileNum (L)^. EndOfFile Then
                          Begin
                            ReadLn (GetPFileNum (L)^. Handle, S1);
                            GetPFileNum (L)^. EndOfFile := IOResult <> 0;
                          End Else
                            S1 := '';

                          ChangeVar (T, S1);
                        End;
                      End
                      Else If Command = 'FILEGETTOSTRING' Then
                      Begin
                        TimeSlice;
                        Parameter := UpString (Trim (ExtractWord (2, S, ['(', ')'])));
                        L := Str2Long (Trim (ExtractWord (1, Parameter, [','])));
                        T := Trim (ExtractWord (2, Parameter, [',']));

                        If Not MathExpression (T) Then Error (seIncorrectParams) Else
                        Begin
                          PF := GetPFileNum (L);
                          Close (PF^. Handle);
                          Reset (PF^. Handle);
                          L := Str2Long (T);

                          For i := 1 To L-1 Do
                          If Not EoF (PF^. Handle) Then ReadLn (PF^. Handle, S1) Else Break;

                          If IOResult <> 0 Then;
                        End;
                      End
                      Else If Command = 'FILEEXISTS' Then
                      Begin
                        Parameter := UpString (Trim (ExtractWord (2, S, ['(', ')'])));
                        Par1 := StrExpression (Trim (ExtractWord (1, Parameter, [','])), False);
                        Par2 := Trim (ExtractWord (2, Parameter, [',']));

                        If (GetVar (Par2) = nil) Or (GetVar (Par2)^. VarType <> tvLogical) Then Error (seIncorrectParams) Else
                        Begin
                          S1 := ZeroOne [FileExists (Par1)];
                          ChangeVar (Par2, S1);
                        End;
                      End
                      Else If Command = 'FILEDELETE' Then
                      Begin
                        tDeleteFile (StrExpression (Trim (ExtractWord (2, S, ['(', ')'])), False));
                      End
                      Else If Command = 'GETSTRINGLENGTH' Then
                      Begin
                        Parameter := UpString (Trim (ExtractWord (2, S, ['(', ')'])));
                        S := Trim (ExtractWord (1, Parameter, [',']));
                        T := Trim (ExtractWord (2, Parameter, [',']));

                        If (GetVar (S) = nil) Or (GetVar (T) = nil) Or
                           (GetVar (T)^. VarType <> tvNumber)
                        Then Error (seIncorrectParams)
                        Else ChangeVar (T, Long2Str (Length (GetValue (S))));
                      End
                      Else If Command = 'UPCASE' Then
                      Begin
                        S := UpString (Trim (ExtractWord (2, S, ['(', ')'])));
                        If GetVar (S) = nil
                        Then Error (seUnknown)
                        Else ChangeVar (S, UpString (GetValue (S)));
                      End
                      Else If Command = 'LOCASE' Then
                      Begin
                        S := UpString (Trim (ExtractWord (2, S, ['(', ')'])));
                        If GetVar (S) = nil Then Error (seUnknown)
                        Else ChangeVar (S, LoString (GetValue (S)));
                      End
                      Else If Command = 'PRCASE' Then
                      Begin
                        S := UpString (Trim (ExtractWord (2, S, ['(', ')'])));
                        If GetVar (S) = nil Then Error (seUnknown)
                        Else ChangeVar (S, PrString (GetValue (S)));
                      End
                      Else If Command = 'GETCURSORCOORD' Then
                      Begin
                        Parameter := UpString (Trim (ExtractWord (2, S, ['(', ')'])));
                        Par1 := Trim (ExtractWord (1, Parameter, [',']));
                        Par2 := Trim (ExtractWord (2, Parameter, [',']));

                        If ((GetVar (Par1) = nil) Or (GetVar (Par1)^. VarType <> tvNumber)) Or
                           ((GetVar (Par2) = nil) Or (GetVar (Par2)^. VarType <> tvNumber)) Then Error (seUnknown) Else
                        Begin
                          ChangeVar (Par1, Long2Str (WhereX));
                          ChangeVar (Par2, Long2Str (WhereY));
                        End;
                      End
                      Else If Command = 'SUBSTRING' Then
                      Begin
                        Parameter := UpString (Trim (ExtractWord (2, S, ['(', ')'])));
                        S  := Trim (ExtractWord (1, Parameter, [',']));
                        Par1 := Trim (ExtractWord (2, Parameter, [',']));
                        Par2 := Trim (ExtractWord (3, Parameter, [',']));
                        S1 := Trim (ExtractWord (4, Parameter, [',']));

                        If (GetVar (S) = nil) Or (GetVar (S1) = nil) Then Error (seUnknown) Else
                        {$B+}
                        If (GetVar (S)^. VarType <> tvString) Or
                           (GetVar (S1)^. VarType <> tvString) Or
                           Not MathExpression (Par1) Or
                           Not MathExpression (Par2)
                        {$B-}
                        Then Error (seIncorrectParams)
                        Else ChangeVar (S1, Copy (PString (GetVar (S)^.
                        Value)^, Str2Long (Par1), Str2Long (Par2)));
                      End
                      Else If Command = 'STRPOS' Then
                      Begin
                        Parameter := Trim (ExtractAscii (2, S, ['(', ')'], '"'));
                        S1 := StrExpression (Trim (ExtractAscii (1, Parameter, [','], '"')), True);
                        S  := StrExpression (Trim (ExtractAscii (2, Parameter, [','], '"')), True);
                        T  := Trim (ExtractAscii (3, Parameter, [','], '"'));

                        If (GetVar (T) = nil) Or (GetVar (T)^. VarType <> tvNumber)
                        Then Error (seIncorrectParams)
                        Else ChangeVar (T, Long2Str (Pos (S1, S)));
                      End
                      Else If Command = 'VAL' Then
                      Begin
                        Parameter := UpString (Trim (ExtractWord (2, S, ['(', ')'])));
                        S  := StrExpression (Trim (ExtractWord (1, Parameter, [','])), True);
                        S1 := Trim (ExtractWord (2, Parameter, [',']));

                        If (GetVar (S1) = nil) Or (GetVar (S1)^. VarType <> tvNumber)
                        Then Error (seUnknown) Else
                        ChangeVar (S1, Long2Str (Str2Long (Trim (S))));
                      End
                      Else If Command = 'ORD' Then
                      Begin
                        Parameter := UpString (Trim (ExtractWord (2, S, ['(', ')'])));
                        S  := StrExpression (Trim (ExtractWord (1, Parameter, [','])), True);
                        S1 := Trim (ExtractWord (2, Parameter, [',']));

                        If (GetVar (S1) = nil) Or (GetVar (S1)^. VarType <> tvNumber)
                        Then Error (seUnknown) Else
                        ChangeVar (S1, Long2Str (Ord (S [1])));
                      End
                      Else If Command = 'FILEWRITESTRING' Then
                      Begin
                        Parameter := Trim (ExtractAscii (2, S, ['(', ')'], '"'));
                        T := StrExpression (Trim (ExtractAscii (2, Parameter, [','], '"')), True);
                        L := Str2Long (Trim (ExtractAscii (1, Parameter, [','], '"')));

                        WriteLn (PFile (GetPFileNum (L))^. Handle, T);
                      End
                      Else If Command = 'FILEPOST' Then
                      Begin
                        Parameter := Trim (ExtractAscii (2, S, ['(', ')'], '"'));

                        S    := StrExpression (Trim (ExtractAscii (1, Parameter, [','], '"')), True);
                        S1   := StrExpression (Trim (ExtractAscii (2, Parameter, [','], '"')), True);
                        Par1 := StrExpression (Trim (ExtractAscii (3, Parameter, [','], '"')), True);
                        Par2 := StrExpression (Trim (ExtractAscii (4, Parameter, [','], '"')), True);

                        PostFile (S, MtoAbs (R. MsgGroup, R. MsgArea), S1,
                          Par1, Par2, MsgArea. Address, MsgArea. Address,
                          pfAutoOpen+pfUseDefaultAddr);
                      End
                      Else If Command = 'WRITEMSG' Then
                      Begin
                        Parameter := Trim (ExtractAscii (2, S, ['(', ')'], '"'));

                        If Parameter <> '' Then
                        If Not MathExpression (Parameter) Then Error (seIncorrectParams);

                        PrePostMsg (Parameter);
                      End
                      Else If Command = 'ADDTODOWNLOADLIST' Then
                      Begin
                        Parameter := StrExpression (Trim (ExtractAscii
                                     (2, S, ['(', ')'], '"')), True);

                        If FileExists (Parameter) Then
                        With TagFileRec, F2Transfer^ Do
                        Begin
                          PathName         := Parameter;
                          AreaNum          := 0;
                          Size             := gFileSize (Parameter);
                          TagFileRec. Free := False;
                          FromName         := '';

                          If Not InTagList (PathName) Then
                          Begin
                            Insert (NewTagFile (TagFileRec));
                            Inc (SizeOfAll, Size);
                          End;

                        End;

                        UpdateReservedVars;
                      End
                      Else If Command = 'EXEC' Then
                      Begin
                        Parameter := Trim (ExtractAscii (2, S, ['(', ')'], '"'));
                        S    := TranslateExecParams (StrExpression (Trim (ExtractAscii (1, Parameter, [','], '"')), True));
                        S1   := Trim (ExtractAscii (2, Parameter, [','], '"'));

                        If S1 <> ''
                        Then
                          L := DosShell (S, exDirect, False)
                        Else
                          DosShell (S, exCommand, False);

                        If (GetVar (S1) <> Nil) And (GetVar (S1)^. VarType = tvNumber)
                        Then ChangeVar (S1, Long2Str (L));
                      End
                      Else If Command = 'GOTO' Then GoToLabel (ExtractWord (2, S1, [' ']))
                      Else If Command = 'EXIT' Then
                      Begin
                        If Not ProcExec Then Break Else ProcLine := ProcText^. Count-1;
                      End Else
                      If Command = 'DOWNLOAD' Then
                      Begin
                        Parameter := StrExpression (Trim (ExtractAscii
                                     (2, S, ['(', ')'], '"')), True);

                        If Parameter <> '' Then
                        If FileExists (Parameter) Then
                        With TagFileRec, F2Transfer^ Do
                        Begin
                          PathName         := Parameter;
                          AreaNum          := 0;
                          Size             := gFileSize (Parameter);
                          TagFileRec. Free := False;
                          FromName         := '';

                          If Not InTagList (PathName) Then
                          Begin
                            Insert (NewTagFile (TagFileRec));
                            Inc (SizeOfAll, Size);
                          End;

                        End;

                        UpdateReservedVars;
                        DownLoad;
                        UpdateReservedVars;
                      End
                      Else If Command = 'UPLOAD' Then
                      Begin
                        Parameter := StrExpression (Trim (ExtractAscii
                                     (2, S, ['(', ')'], '"')), True);
                        UpLoadToUser := '';
                        T := FileArea. ULPath;
                        If Parameter <> '' Then FileArea. ULPath := AddBackSlash (Parameter);
                        UpdateReservedVars;
                        Transfer (Parameter, Receive, tsNormal);
                        UpdateReservedVars;
                        If Parameter <> '' Then FileArea. ULPath := T;
                      End
                      Else If Command = 'UPLOADPRIV' Then
                      Begin
                        UpLoadToUser := StrExpression (Trim (ExtractAscii (2, S, ['(', ')'], '"')), True);
                        Transfer (UpLoadToUser, Receive, tsPrivate);
                      End
                      Else If Command = 'GLOBALSEARCH' Then
                      Begin
                        Parameter := StrExpression (Trim (ExtractAscii (2, S, ['(', ')'], '"')), True);
                        If Parameter = '' Then Parameter := GetAnswer (lang (laSearchMask), 12, ofAllowEmpty, '');
                        If Parameter <> '' Then GlobalSearch (Parameter, False, atNo, '');
                      End
                      Else If Command = 'NEWFILESSINCE' Then
                      Begin
                        Parameter := StrExpression (Trim (ExtractAscii (2, S, ['(', ')'], '"')), True);
                        GlobalSearch ('*.*', True, atNo, Parameter);
                      End
                      Else If Command = 'NEWFILESSINCELAST' Then
                      Begin
                        GlobalSearch ('*.*', True, atYes, '');
                      End
                      Else If Command = 'CHANGEFILEAREA' Then SelectFArea
                      Else If Command = 'CHANGEMSGAREA' Then SelectMArea
                      Else If Command = 'CHANGEFILEGROUP' Then SelectFGroup
                      Else If Command = 'CHANGEMSGGROUP' Then SelectMGroup
                      Else If Command = 'DELAY' Then
                      Begin
                        S1 := ExtractWord (2, S, ['(', ')']);
                        If Not MathExpression (S1) Then Error (seIncorrectParams);
                        Pause (Abs (Str2Long (S1)));
                      End
                      Else If Command = 'FILELIST' Then
                      Begin
                        LogWrite ('+', sm (smlBrowsingFArea) + ZeroMsg (FileArea. Name, True));
                        InitMore (0);
                        DispFilesBBS ('*.*', '', False, False, tB);
                      End
                      Else If Command = 'SHOWRAWDIR' Then
                      Begin
                        If (FileArea. List_Security > R. Security) or
                           (Not FlagsValid (R. Flags, FileArea. List_Flags)) Then
                        Begin
                          If R. HotKeys Then ComWriteLn ('', 0);
                          Message (lang (laSecurityLow));
                        End Else
                        Begin
                          LogWrite ('+', sm (smlBrowsingFArea) + ZeroMsg (FileArea. Name, True));
                          InitMore (0);
                          DispFilesBBS ('*.*', '', False, True, tB);
                        End
                      End
                      Else If Command = 'GETFIRSTTAGGED' Then
                      Begin
                        T := Trim (ExtractAscii (2, S, ['(', ')'], '"'));
                        If (GetVar (T) = Nil) Or (GetVar (T)^. VarType <> tvString) Then Error (seIncorrectParams) Else
                        Begin
                          TagFileNum := 0;
                          If F2Transfer^. Count = 0 Then S1 := '' Else
                          S1 := PTagFileRec (F2Transfer^. At (TagFileNum))^. PathName;
                          ChangeVar (T, S1);
                        End;
                      End
                      Else If Command = 'GETNEXTTAGGED' Then
                      Begin
                        T := Trim (ExtractAscii (2, S, ['(', ')'], '"'));
                        If (GetVar (T) = Nil) Or (GetVar (T)^. VarType <> tvString) Then Error (seIncorrectParams) Else
                        Begin
                          Inc (TagFileNum);

                          If TagFileNum >= F2Transfer^. Count Then S1 := '' Else
                          S1 := PTagFileRec (F2Transfer^. At (TagFileNum))^. PathName;
                          ChangeVar (T, S1);
                        End;
                      End
                      Else If Command = 'PAGESYSOP' Then
                      Begin
                        Parameter := Trim (ExtractAscii (2, S, ['(', ')'], '"'));
                        PageSysOp (StrExpression (Parameter, False));
                      End
                      Else If Command = 'CALL' Then
                      Begin
                        Parameter := Trim (ExtractAscii (2, S, ['(', ')'], '"'));
                        ExecScript (StrExpression (Parameter, False));
                      End
                      Else If Command = 'KEYMACRO' Then
                      Begin
                        Parameter := StrExpression (Trim (ExtractAscii (2, S, ['(', ')'], '"')), False);
                        KeyBuffer := KeyBuffer + Parameter;
                      End
                      Else If Command = 'LOG' Then
                      Begin
                        Parameter := StrExpression (Trim (ExtractAscii (2, S, ['(', ')'], '"')), False);
                        LogWrite ('%', Parameter);
                      End
                      Else If Command = 'DOORWAY' Then
                      Begin
                        LogWrite ('+', sm (smlEnterDW));
                        GetDir (0, S1);
                        CommandProcessor;
                        LogWrite ('+', sm (smExitDW));
                        SmartChDir (S1);
                      End
                      Else If Command = 'NEWS' Then
                      Begin
                        News (False);
                      End
                      Else If Command = 'TELNET' Then
                      Begin
                      {$IFNDEF MSDOS}
                        Parameter := Trim (ExtractAscii (2, S, ['(', ')'], '"'));
                        GoTelnet (StrExpression (Parameter, False));
                      {$ENDIF}
                      End
                      Else If Command = 'USERINFO' Then
                      Begin
                        Parameter := StrExpression (Trim (ExtractAscii (2,
                        S, ['(', ')'], '"')), True);

                        If (Parameter = '') And
                           (R. Security >= Cnf. UserInfoMinSec) And
                           FlagsValid (R. Flags, Cnf. UserInfoMinFlags) Then
                        Begin
                          If Cnf. CapitalizeNames
                            Then SetInputCap (Proper, LettersOnly)
                            Else SetInputCap (NoCaps, LettersOnly);

                          UserInfo (GetAnswer (lang (laUserName), 36, ofAllowEmpty, ''));
                          SetInputCap (NoCaps, AllChars);
                        End Else
                          UserInfo (Parameter)
                      End
                      Else If GetProc (Command) <> Nil Then
                      Begin
                        If Not ProcExec
                        Then
                          S := 'MAIN`' + Long2Str (LineNum) + '`1`' +
                          Long2Str (IfCount1)
                        Else
                          S := ProcName + '`' + Long2Str (LineNum) + '`' +
                               Long2Str (ProcLine) + '`' +
                               Long2Str (IfCount1);

                        ProcStack^. Insert (NewStr (S + '`' + BufStr));
                        LineNum := GetProc (Command)^. Start;
                        ProcLine := 0;
                        ProcText := GetProc (Command)^. Text;
                        ProcName := Command;
                        IfCount1 := 0;
                        ProcExec := True;
                        BufStr := '';

                        {
                        WriteLn ('---');
                        For i := 0 To ProcText^. Count-1 Do
                        WriteLn (PString (ProcText^. At (i))^);
                        }
                      End Else
                      If GetVar (Command) <> Nil Then
                      Begin
                        If Not PVariable (GetVar (Command))^. ReadOnly Then
                        Begin
                          Parameter := Trim (ExtractWord (2, S, ['=']));

                          Case PVariable (GetVar (Command))^. VarType Of
                            tvString   : Parameter := StrExpression (Parameter, True);
                            tvLogical  : Begin
                                           Parameter := UpString (Parameter);

                                           If Parameter = 'TRUE'
                                           Then Parameter := '1' Else
                                           If Parameter = 'FALSE'
                                           Then Parameter := '0' Else
                                           If LogicExpression (Parameter)
                                           Then Parameter := '1' Else
                                           If Not LogicExpression (Parameter)
                                           Then Parameter := '0';
                                         End;
                            tvNumber : If Not MathExpression (Parameter) Then Break;
                          End;

                          ChangeVar (Command, Parameter);
                          If Command [1] = '$' Then
                          Begin
                            SetMacro (Command, Parameter);
                            UpdateConnected (Command);
                          End;

                        End Else
                          Error (seReadOnly);
                      End Else
                        Error (seUnknown);
                    End;
    End;
  End;

  While Variables^. Count > 0 Do
  Begin
    DisposeVariable (Variables^. At (0));
    Variables^. AtDelete (0);
  End;

  While Procedures^. Count > 0 Do
  Begin
    DisposeProcedure (Procedures^. At (0));
    Procedures^. AtDelete (0);
  End;

  While Files^. Count > 0 Do
  Begin
    Close (PFile (Files^. At (0))^. Handle);
    If IOResult <> 0 Then;
    DisposePFile (Files^. At (0));
    Files^. AtDelete (0);
  End;

  While Labels^. Count > 0 Do
  Begin
    DisposeScriptLabel (Labels^. At (0));
    Labels^. AtDelete (0);
  End;

  ScriptParams^. FreeAll;
  ScriptParams^. DeleteAll;

  Dispose (Files, Done);
  Dispose (Labels, Done);
  Dispose (Variables, Done);
  Dispose (Procedures, Done);
  Dispose (ScriptParams, Done);
  Dispose (ProcStack, Done);

  Close (F);
  tExecScript := True;
End;

End.