Unit
  tREXX;

Interface

Uses
  tGlob,
  DOS,
  Os2Def,
  Os2Base,
  Os2Rexx,
  Strings,
  Areas,
  MainComm,
  FilesBBS,
  Shell,
  tMisc,
  Protocol,
  TorInOut,
  TorMacro,
  Parse,
  OpCrt,
  tScript,
  RexxAPI;

Function InitRexx: Boolean;
Function tExecRexx (FName: PathStr): Boolean;

Implementation

Const
  RexxRegistered : Boolean = False;

Var
  TagFileRec            : TTagFileRec;

Function rxFormRet (S: String): RxString;
Var
  Rez : RxString;

Begin
  Rez. StrLength := Length (S);
  If Rez. StrLength > 0 Then
  Begin
    GetMem (Rez. StrPtr, Rez. StrLength+1);
    StrPCopy (Rez. StrPtr, S);
  End;

  rxFormRet := Rez;
End;

Function Subcommand (Com: PRxString; Var Err_flag: SmallWord; Var Ret: RxString): ULong; CDecl;
Begin
  Err_flag := 0;
  Ret. StrLength := 0;
  Subcommand := 0;
End;

Function rxGetMacro (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  S, R  : String;
  Tmp   : PElementOfMacrosTable;
  Found : Boolean;

Begin
  If ArgC = 1 Then
  Begin
    S := StrPas (Args^. StrPtr);

    If (S [1] = '$') And (Length (S) = 5) Then
    Begin
      Tmp := ScreenOut^. MacroTable1^. Table;
      S := Copy (S, 2, 4);
      Found := False;

      While Tmp <> Nil Do
      Begin
        If Tmp^. MacroName = S Then
        Begin
          R := Tmp^. MacroStr;
          Found := True;
          Break;
        End;
        Tmp := Tmp^. NextElement;
      End;

      If Not Found Then R := '-1';
    End Else
      R := '-1';

    rxGetMacro := 0;
    If R = '' Then R := '0';
    Ret := rxFormRet (R);
  End Else
    rxGetMacro := -1;
End;

Function rxSetMacro (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  S, S1, Z : String;

Begin
  If ArgC = 2 Then
  Begin
    S := StrPas (Args^. StrPtr); Inc (Args);
    S1 := StrPas (Args^. StrPtr);
    Z := '0';
    SetMacro (S, S1);
    Ret := rxFormRet (Z);
    rxSetMacro := 0;
  End Else
    rxSetMacro := -1;
End;

Function rxClear (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 0 Then
  Begin
    Cls;
    Ret := rxFormRet ('0');
    rxClear := 0;
  End Else
    rxClear := -1;
End;

Function rxHangUp (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 0 Then
  Begin
    NormExit;
    Ret := rxFormRet ('0');
    rxHangUp := 0;
  End Else
    rxHangUp := -1;
End;

Function rxChangeFArea (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 0 Then
  Begin
    SelectFArea;
    Ret := rxFormRet ('0');
    rxChangeFArea := 0;
  End Else
    rxChangeFArea := -1;
End;

Function rxChangeFGroup (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 0 Then
  Begin
    SelectFGroup;
    Ret := rxFormRet ('0');
    rxChangeFGroup := 0;
  End Else
    rxChangeFGroup := -1;
End;

Function rxChangeMArea (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 0 Then
  Begin
    SelectMArea;
    Ret := rxFormRet ('0');
    rxChangeMArea := 0;
  End Else
    rxChangeMArea := -1;
End;

Function rxChangeMGroup (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 0 Then
  Begin
    SelectMGroup;
    Ret := rxFormRet ('0');
    rxChangeMGroup := 0;
  End Else
    rxChangeMGroup := -1;
End;

Function rxFileList (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  tB : Boolean;

Begin
  If ArgC = 0 Then
  Begin
    InitMore (0);
    DispFilesBBS ('*.*', '', False, False, tB);
    Ret := rxFormRet ('0');
    rxFileList := 0;
  End Else
    rxFileList := -1;
End;

Function rxShowRawDir (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  tB : Boolean;

Begin
  If ArgC = 0 Then
  Begin
    InitMore (0);
    DispFilesBBS ('*.*', '', False, True, tB);
    Ret := rxFormRet ('0');
    rxShowRawDir := 0;
  End Else
    rxShowRawDir := -1;
End;

Function rxDoorWay (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  S1 : PathStr;

Begin
  If ArgC = 0 Then
  Begin
    GetDir (0, S1);
    CommandProcessor;
    {$I-} SmartChDir (S1);
    {$I+} Ret := rxFormRet ('0');
    rxDoorWay := 0;
  End Else
    rxDoorWay := -1;
End;

Function rxNews (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 0 Then
  Begin
    News (False);
    Ret := rxFormRet ('0');
    rxNews := 0;
  End Else
    rxNews := -1;
End;

Function rxFileDisplay (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 1 Then
  Begin
    EmuDispFile (StrPas (Args^. StrPtr));
    Ret := rxFormRet ('0');
    rxFileDisplay := 0;
  End Else
    rxFileDisplay := -1;
End;

Function rxAddToDList (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 1 Then
  Begin
    If FileExists (StrPas (Args^. StrPtr)) Then
    With TagFileRec, F2Transfer^ Do
    Begin
      PathName := StrPas (Args^. StrPtr);
      AreaNum := 0;
      Size := gFileSize (PathName);
      TagFileRec. Free := False;
      FromName := '';
      Insert (NewTagFile (TagFileRec));
      Ret := rxFormRet ('0');
    End Else
      Ret := rxFormRet ('-1');

    rxAddToDList := 0;
  End Else
    rxAddToDList := -1;
End;

Function rxDownLoad (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC <= 1 Then
  Begin
    If ArgC = 1 Then
    If FileExists (StrPas (Args^. StrPtr)) Then
    With TagFileRec, F2Transfer^ Do
    Begin
      PathName := StrPas (Args^. StrPtr);
      AreaNum := 0;
      Size := gFileSize (PathName);
      TagFileRec. Free := False;
      FromName := '';
      Insert (NewTagFile (TagFileRec));
    End;

    DownLoad;
    rxDownLoad := 0;
    Ret := rxFormRet ('0');
  End Else
    rxDownLoad := -1;
End;

Function rxUpLoad (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  Parameter : PathStr;

Begin
  If ArgC <= 1 Then
  Begin
    If ArgC = 1 Then Parameter := AddBackSlash (StrPas (Args^. StrPtr)) Else Parameter := '';
    UpLoadToUser := '';

    If Parameter <> '' Then
    Begin
      AutoDL := True;
      SmartChDir (Parameter);
    End;

    Transfer (Parameter, Receive, tsNormal);
    If Parameter <> '' Then SmartChDir (Cnf. Path);

    Ret := rxFormRet ('0');
    rxUpLoad := 0;
  End Else
    rxUpLoad := -1;
End;

Function rxUpLoadPriv (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 1 Then
  Begin
    Transfer (StrPas (Args^. StrPtr), Receive, tsPrivate);
    Ret := rxFormRet ('0');
    rxUpLoadPriv := 0;
  End Else
    rxUpLoadPriv := -1;
End;

Function rxWrite (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  For i := 1 To ArgC Do
  Begin
    ComWrite (StrPas (Args^. StrPtr), eoMacro+eoCodes);
    Inc (Args);
  End;

  rxWrite := 0;
  Ret := rxFormRet ('0');
End;

Function rxWriteLn (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  For i := 1 To ArgC Do
  Begin
    ComWrite (StrPas (Args^. StrPtr), eoMacro+eoCodes);
    Inc (Args);
  End;

  ComWriteLn ('', 0);
  rxWriteLn := 0;
  Ret := rxFormRet ('0');
End;

Function rxMessage (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  S : String;

Begin
  If ArgC <= 1 Then
  Begin
    If ArgC = 1 Then S := StrPas (Args^. StrPtr) Else S := '';
    Message (S);
    Ret := rxFormRet ('0');
    rxMessage := 0;
  End Else
    rxMessage := -1;
End;

Function rxFilePost (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  FName, FromName, ToName, Subj : String;

Begin
  If ArgC = 4 Then
  Begin
    FName := StrPas (Args^. StrPtr); Inc (Args);
    FromName := StrPas (Args^. StrPtr); Inc (Args);
    ToName := StrPas (Args^. StrPtr); Inc (Args);
    Subj := StrPas (Args^. StrPtr);
    PostFile (FName, MtoAbs (R. MsgGroup, R. MsgArea), FromName, ToName, Subj, MsgArea. Address, MsgArea. Address, pfAutoOpen);
    Ret := rxFormRet ('0');
    rxFilePost := 0;
  End Else
    rxFilePost := -1;
End;

Function rxWriteMsg (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  S : String;

Begin
  If ArgC <= 1 Then
  Begin
    rxWriteMsg := 0;
    If ArgC = 1 Then S := StrPas (Args^. StrPtr) Else S := '';

    If S <> '' Then
    If Not ConsistsOf (S, ['0'..'9']) Then
    Begin
      Ret := rxFormRet ('-1');
      Exit;
    End;

    PrePostMsg (S);
    Ret := rxFormRet ('0');
  End Else
    rxWriteMsg := -1;
End;

Function rxUserInfo (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  S : String;

Begin
  If ArgC <= 1 Then
  Begin
    rxUserInfo := 0;
    If ArgC = 1 Then S := StrPas (Args^. StrPtr) Else S := '';

    If S = '' Then
    Begin
      If Cnf. CapitalizeNames Then
        SetInputCap (Proper, LettersOnly)
      Else
        SetInputCap (NoCaps, LettersOnly);

      UserInfo (GetAnswer (lang (laUserName), 36, ofAllowEmpty, ''));
    End Else
      UserInfo (S);
    SetInputCap (NoCaps, AllChars);

    Ret := rxFormRet ('0');
  End Else
    rxUserInfo := -1;
End;

Function rxPageSysOp (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  S : String;

Begin
  If ArgC <= 1 Then
  Begin
    rxPageSysOp := 0;
    If ArgC = 1 Then S := StrPas (Args^. StrPtr) Else S := '';
    PageSysOp (S);
    Ret := rxFormRet ('0');
  End Else
    rxPageSysOp := -1;
End;

Function rxGlobalSearch (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  S : String;

Begin
  If ArgC <= 1 Then
  Begin
    rxGlobalSearch := 0;
    If ArgC = 1 Then S := StrPas (Args^. StrPtr) Else S := '';
    If S = '' Then S := GetAnswer (lang (laSearchMask), 12, ofAllowEmpty, '');
    If S <> '' Then GlobalSearch (S, False, atNo, '');
    Ret := rxFormRet ('0');
  End Else
    rxGlobalSearch := -1;
End;

Function rxReadVar (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  S, S1 : String;
  L     : Byte;

Begin
  If ArgC = 2 Then
  Begin
    S  := StrPas (Args^. StrPtr); Inc (Args);
    S1 := StrPas (Args^. StrPtr);

    If ConsistsOf (S1, ['0'..'9']) Then
    Begin
      L := Str2Long (S1);
      S1 := '';
      ComReadLn (S1, L, $02);
      If SetRexxVar (S, S1) Then
        Ret := rxFormRet ('0')
      Else
        Ret := rxFormRet ('-1');
    End Else
      Ret := rxFormRet ('-1');

    rxReadVar := 0;
  End Else
    rxReadVar := -1;
End;

Function rxKeyPressed (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 0 Then
  Begin
    If Incoming Then Ret := rxFormRet ('1') Else Ret := rxFormRet ('0');
    rxKeyPressed := 0;
  End Else
    rxKeyPressed := -1;
End;

Function rxReadKey (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 0 Then
  Begin
    Ret := rxFormRet (ComReadKey);
    rxReadKey := 0;
  End Else
    rxReadKey := -1;
End;

Function rxSetCursorCoord (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  S1, S2 : String;

Begin
  If ArgC = 2 Then
  Begin
    S1 := StrPas (Args^. StrPtr); Inc (Args);
    S2 := StrPas (Args^. StrPtr);

    If ConsistsOf (S1, ['0'..'9']) And ConsistsOf (S2, ['0'..'9']) Then
    Begin
      ComWrite (EmuGoToXY (Str2Long (S1), Str2Long (S2)), $07);
      Ret := rxFormRet ('0');
    End Else
      Ret := rxFormRet ('-1');

    rxSetCursorCoord := 0;
  End Else
    rxSetCursorCoord := -1;
End;

Function rxGetCursorCoord (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  S1, S2 : String;

Begin
  If ArgC = 2 Then
  Begin
    S1 := StrPas (Args^. StrPtr); Inc (Args);
    S2 := StrPas (Args^. StrPtr);

    If SetRexxVar (S1, Long2Str (WhereX)) Then
    Begin
      If SetRexxVar (S2, Long2Str (WhereY)) Then Ret := rxFormRet ('0');
    End Else
      Ret := rxFormRet ('-1');

    rxGetCursorCoord := 0;
  End Else
    rxGetCursorCoord := -1;
End;

Function rxSetColor (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Var
  S1, S2 : String;

Begin
  If ArgC = 2 Then
  Begin
    S1 := StrPas (Args^. StrPtr); Inc (Args);
    S2 := StrPas (Args^. StrPtr);

    If ConsistsOf (S1, ['0'..'9']) And ConsistsOf (S2, ['0'..'9']) Then
    Begin
      ComWrite (EmuColor (Str2Long (S1)*16+Str2Long (S2)), 0);
      Ret := rxFormRet ('0');
    End Else
      Ret := rxFormRet ('-1');

    rxSetColor := 0;
  End Else
    rxSetColor := -1;
End;

Function rxYesNo (Name: PChar; ArgC: ULong; Args: PRxString; QueueName: PChar; Var Ret: RxString): ULong; CDecl;
Begin
  If ArgC = 0 Then
  Begin
    If Query ('', True, 0) Then
      Ret := rxFormRet ('1')
    Else
      Ret := rxFormRet ('0');

    rxYesNo := 0;
  End Else
    rxYesNo := -1;
End;

Function InitRexx: Boolean;
Begin
  InitRexx := RexxRegistered;

  If Not RexxRegistered Then
  Begin
    If Not RegisterSubcommand ('TORNADO2', @Subcommand) Then Exit;
    If Not RegisterFunction ('CLEAR', PFn (@rxClear)) Then Exit;
    If Not RegisterFunction ('HANGUP', PFn (@rxHangup)) Then Exit;
    If Not RegisterFunction ('CHANGEFILEAREA', PFn (@rxChangeFArea)) Then Exit;
    If Not RegisterFunction ('CHANGEFILEGROUP', PFn (@rxChangeFGroup)) Then Exit;
    If Not RegisterFunction ('CHANGEMSGAREA', PFn (@rxChangeMArea)) Then Exit;
    If Not RegisterFunction ('CHANGEMSGGROUP', PFn (@rxChangeMGroup)) Then Exit;
    If Not RegisterFunction ('FILELIST', PFn (@rxFileList)) Then Exit;
    If Not RegisterFunction ('DOORWAY', PFn (@rxDoorWay)) Then Exit;
    If Not RegisterFunction ('FILEDISPLAY', PFn (@rxFileDisplay)) Then Exit;
    If Not RegisterFunction ('ADDTODOWNLOADLIST', PFn (@rxAddToDList)) Then Exit;
    If Not RegisterFunction ('DOWNLOAD', PFn (@rxDownLoad)) Then Exit;
    If Not RegisterFunction ('UPLOAD', PFn (@rxUpLoad)) Then Exit;
    If Not RegisterFunction ('WRITE', PFn (@rxWrite)) Then Exit;
    If Not RegisterFunction ('WRITELN', PFn (@rxWriteLn)) Then Exit;
    If Not RegisterFunction ('MESSAGE', PFn (@rxMessage)) Then Exit;
    If Not RegisterFunction ('GETMACRO', PFn (@rxGetMacro)) Then Exit;
    If Not RegisterFunction ('SETMACRO', PFn (@rxSetMacro)) Then Exit;
    If Not RegisterFunction ('UPLOADPRIV', PFn (@rxUpLoadPriv)) Then Exit;
    If Not RegisterFunction ('SHOWRAWDIR', PFn (@rxShowRawDir)) Then Exit;
    If Not RegisterFunction ('FILEPOST', PFn (@rxFilePost)) Then Exit;
    If Not RegisterFunction ('WRITEMSG', PFn (@rxWriteMsg)) Then Exit;
    If Not RegisterFunction ('USERINFO', PFn (@rxUserInfo)) Then Exit;
    If Not RegisterFunction ('PAGESYSOP', PFn (@rxPageSysOp)) Then Exit;
    If Not RegisterFunction ('READVAR', PFn (@rxReadVar)) Then Exit;
    If Not RegisterFunction ('KEYPRESSED', PFn (@rxKeyPressed)) Then Exit;
    If Not RegisterFunction ('READKEY', PFn (@rxReadKey)) Then Exit;
    If Not RegisterFunction ('SETCURSORCOORD', PFn (@rxSetCursorCoord)) Then Exit;
    If Not RegisterFunction ('GETCURSORCOORD', PFn (@rxGetCursorCoord)) Then Exit;
    If Not RegisterFunction ('SETCOLOR', PFn (@rxSetColor)) Then Exit;
    If Not RegisterFunction ('YESNO', PFn (@rxYesNo)) Then Exit;
    If Not RegisterFunction ('NEWS', PFn (@rxNews)) Then Exit;
    If Not RegisterFunction ('GLOBALSEARCH', PFn (@rxGlobalSearch)) Then Exit;
    RexxRegistered := True;
    InitRexx := True;
  End;
End;

Function tExecRexx (FName: PathStr): Boolean;
Var
  Args        : Array [1..10] Of String;
  RetStr      : String;
  ArgCount, j : Byte;

Begin
  tExecRexx := False;
  ArgCount := 0;
  j := WordCount (fName, [' ']);
  If j > 11 Then j := 11;

  For i := 2 To j Do
  Begin
    Args [i-1] := ExtractWord (i, fName, [' ']);
    Inc (ArgCount);
  End;

  FName := DefaultName (ExtractWord (1, FName, [' ']), 'trx', lang (laTxtFiles));
  If FileExists (FName) Then tExecRexx := ExecuteRexx ('TORNADO2', FName, ArgCount, Args, RetStr);
End;

End.
