{$IFNDEF OS2}
{$O+,F+}
{$ENDIF}
{$I-}

Unit Shell;

{*********************************************************}
{*                       SHELL.PAS                       *}
{*                                                       *}
{*  Copyright (c) Alex Radzishevskiy, 1995-96,           *}
{*   Portions (c) Konstantin Klyagin, 1996-98,           *}
{*                exspecially for Tornado BBS System     *}
{*                                                       *}
{*********************************************************}

Interface

Procedure InitShellUnit;
Procedure CommandProcessor;

Implementation

Uses

{$IFDEF MSDOS}
  ExecSwap,
{$ENDIF}

{$IFDEF OS2}
  Os2PmApi,
  Os2Def,
  Os2Base,
  VPSysLow,
  VPUtils,
  {Crt,}
{$ENDIF}

{$IFNDEF WIN32}
  ApSame,
  DOS,
  tWin,
{$ELSE}
  Windows,
  SysUtils,
  Forms,
  AppExec,
  Startup,
  tor32u,
{$ENDIF}

  Locate,
  tMisc,
  MainComm,
  Parse,
  Log,
  OpCrt,
  xDel,
  DirSize,
  Protocol,
  Resource,
  TGlob,
  Areas,
  Users,
  TimeTask,
  Doors,
  tFSed,
  Objects,
  FilesBBS;

Var
  DW            : DoorWayControlRec;

Const
  LongNames      : Boolean = {$IFDEF MSDOS} False {$ELSE} True {$ENDIF};

Procedure WFileName (FName: PathStr);
Begin
  fLocate_Continue := fLocate_Continue and More;
  If fLocate_Continue Then ComWriteLn (Trim (NiceFileName (FName, 78)), 0);
End;

Function fDosShell (Prg: String; CommandCom, LogErrorLevel: Boolean): Word;
{$IFNDEF WIN32}
Var
  SwapLoc                       : Array [Boolean] Of String [20];
{$ENDIF}

Procedure ExecPrepare;
Begin
  {$IFDEF MSDOS}
  WriteLn ('þ ' + sm (smSwapReserved), BytesSwapped,
  sm (smBytes), ' ', SwapLoc [EmsAllocated]);
  {$ENDIF}

  WriteLn ('þ ' + sm (smGenInfo));
  WriteLn;

  If Not Registering Then
  Begin
    DorinfoGen;
    DoorSysGen;
    ExitInfoGen;
  End;
End;

Var
  Status                        : Word;
  Parameters, ExeName, ExeExt   : String;
{$IFNDEF WIN32}
  oxx, oxy, attr                : Byte;
  CurDir                        : PathStr;
  Covers                        : Pointer;
{$ENDIF}
{$IFNDEF WIN32}
Var
  DBits                         : DataBitType;
  SBits                         : StopBitType;
  Parity                        : ParityType;
{$ENDIF}

Begin
{$IFNDEF WIN32}
  SwapLoc [True]  := sm (smSwapEMS);
  SwapLoc [False] := sm (smSwapDisk);

  oxx := WhereX;
  oxy := WhereY;

  ExeName := ExtractAscii (1, Prg, [' '], '"');
  ExeExt := UpString (Copy (ExeName, Length (ExeName)-3, 4));
  CommandCom := (ExeExt <> '.EXE') And (ExeExt <> '.COM');

  If Prg <> '' Then If CommandCom Then Prg := '/c ' + Prg;

  SaveWindow (1, 1, ScrX+1, ScrY+1, True, Covers);
  Attr := TextAttr;
  TextAttr := $07;
  Window (1, 1, ScrX+1, ScrY+1);
  ClrScr;
  GetDir (0, CurDir);

{$IFDEF MSDOS}

  UseEmsIfAvailable := False {True};

  If Not InitExecSwap (HeapPtr, Cnf. TempDir + DelChars ([':'], StrTime) + 'sw.tor') Then
  Begin
    WriteLn ('þ ' + sm (smSwapError));
    LogWrite ('!', sm (smSwapError));
    If Cnf. Sound Then SoundOf ('1 200 1 2 800 1000 -1 2 800');
  End Else
  Begin
    ExecPrepare;
    If Not Local Then DeactivatePort (P, True);
    SwapVectors;

    If CommandCom
    Then
      ExecWithSwap (GetEnv ('COMSPEC'), Prg)
    Else
    Begin
      If AsciiPosition (2, Prg, [' '], '"') > 0
      Then Parameters := Copy (Prg, AsciiPosition (2, Prg, [' '], '"'), 255)
      Else Parameters := '';

      ExecWithSwap (ExeName, Parameters);
    End;

{$IFDEF DROPREAD}
    If Not Registering Then
    Begin
      DorinfoRead;
      DoorSysRead;
      ExitInfoRead;
    End;
{$ENDIF}

    Status := DosExitCode;
    fDosShell := Status;
    SwapVectors;
    SmartChDir (CurDir);
    If Not Local Then
    Begin
      ActivatePort (P, True);

      {$IFDEF WIN32}
      MainForm. ApdComPort. DonePort (P);
      MainForm. ApdComPort. InitPort;
      {ELSE}
      MainForm. ApdComPort. DonePort (P);
      DBits := Cnf. DataBits;
      SBits := Cnf. StopBits;
      {$IFDEF MSDOS}
      Case Cnf. Parity [1] Of
        'N': Parity := NoParity;
        'O': Parity := OddParity;
        'E': Parity := EvenParity;
        'S': Parity := SpaceParity;
        'M': Parity := MarkParity;
      End;
      {$ENDIF}
      InitPort (P, {$IFNDEF OS2} ComNames [Cnf. ComPort] {$ELSE} Com1 {$ENDIF},
                Cnf. BaudRate, Parity, DBits, SBits, 4096, 4096, DefPortOptions);
      {$IFNDEF OS2}
      If Cnf. HWFlow Then HWFlowEnable (P, 2000, 200, hfUseRTS + hfRequireCTS);
      If Cnf. SWFlow Then SWFlowEnable (P, 2000, 200);
      {$ENDIF}
      {$ENDIF}
      SetModem (P, True, True);

    End;
    WriteLn ('þ ' + sm (smErrorlevel), Status);
    ShutdownExecSwap;
  End;

{$ELSE}

  ExecPrepare;

{$IFDEF OS2}
  DOS. ExecFlags := efAsync;
{$ENDIF}
  If CommandCom
  Then DOS. Exec (DOS. GetEnv ('COMSPEC'), Prg)
  Else DOS. Exec (ExeName, Parameters);

  Status := DOS. DosExitCode;
{$ELSE}

{$ENDIF}
  SmartChDir (CurDir);
  WriteLn ('þ ' + sm (smErrorlevel), Status);

  If Not CommandCom And LogErrorLevel
  Then LogWrite (':', sm (smErrorLevel) + Long2Str (Status));

  ReInitCrt;
  TextAttr := 0;
  ClrScr;

{  If StatusBar
    Then RestoreWindow (1, 1, ScrX+1, ScrY-1, True, Covers)
    Else} RestoreWindow (1, 1, ScrX+1, ScrY+1, True, Covers);

  TWinInit;
  If StatusBar Then Window (1, 1, ScrX+1, ScrY-1);
  SetBlink (Cnf. Blinking);
  GotoXY (oxx, oxy);
  TextAttr := Attr;

{$ELSE}
  If Not Registering Then
  Begin
    DorinfoGen;
    DoorSysGen;
    ExitInfoGen;
  End;

  (* If Not Local Then P. Open := False; *)

  With MainForm. Executer Do
  Begin
    Clear;
    Wait := True;
    ChangeDir := False;

    If CommandCom Then
    Begin
      ExeName := Environment. GetEnv ('COMSPEC');
      Prg := '/c ' + Prg;
    End;

    WindowState := MainForm. WindowState;
    ExeParams. Add (Prg);
{    Application. Minimize;}
    MainForm. Hide;

    Try
      Execute;
    Except
      On E:EAppExec Do {MessageBox (E. Message)};
    End;

{    Application. Restore;}
    MainForm. Show;
    Status := ErrNo;
    fDosShell := Status;

    If Not CommandCom And LogErrorLevel
    Then LogWrite (':', sm (smErrorLevel) + Long2Str (Status));
  End;

{$IFDEF DROPREAD}
  If Not Registering Then
  Begin
    DorinfoRead;
    DoorSysRead;
    ExitInfoRead;
  End;
{$ENDIF}

  (* If Not Local Then P. Open := True; *)

{$ENDIF}
End;

Type
  PDirSortedCollection = ^TDirSortedCollection;
  TDirSortedCollection = Object (TSortedCollection)
    Function Compare (Key1, Key2: Pointer):
    {$IFDEF OS2} LongInt {$ELSE} Integer {$ENDIF}; Virtual;
  End;

Function TDirSortedCollection. Compare (Key1, Key2: Pointer):
{$IFDEF OS2} LongInt {$ELSE} Integer {$ENDIF};
Var
  PS1 : PString Absolute Key1;
  PS2 : PString Absolute Key2;
  S1, S2 : String;
  C1, C2 : Char;

Begin
  S1 := PS1^;
  S2 := PS2^;
  C1 := S1 [1];
  C2 := S2 [1];

  If LongNames Then
  Begin
    S1 := Copy (S1, 76, 255);
    S2 := Copy (S2, 76, 255);
  End Else
  Begin
    S1 := Copy (S1, 2, 255);
    S2 := Copy (S2, 2, 255);
  End;

  If ((C1 = #3) And (C2 <> #3)) Or ((C2 = #3) And (C1 <> #3)) Then
  Begin
    If C1 > C2 Then Compare :=  1 Else
    If C1 < C2 Then Compare := -1 Else
    Compare := 0;
  End Else
  Begin
    If S1 > S2 Then Compare :=  1 Else
    If S1 < S2 Then Compare := -1 Else
    Compare := 0;
  End;
End;

Function LnEdMenu (Var S: String): tLineEditResult;
Var
  F : Boolean;

Function iAnalyze: Boolean;
Begin
  iAnalyze := False;

  Case i Of
    1 : Begin
          ComWriteLn ('|\15File saved.', 0);
          LnedMenu := mpSave;
        End;
    2 : Begin
          ComWriteLn ('', 0);
          If Not Query (lang (laSure), False, 0) Then iAnalyze := True;
          LnedMenu := mpAbort;
        End;
    3 : Begin
          ComWriteLn ('', 0);
          LnedMenu := mpContinue;
        End;
    4 : Begin
          S := GetAnswer ('|' + lang (laEnterMsgLine), 2, ofAllowEmpty, '');
          If Trim (S) = '' Then iAnalyze := True;
          LnedMenu := mpEditLine;
        End;
    5 : Begin
          ComWriteLn (#10, 0);
          ComWriteLn (lang (laMsgWriteText3), eoMacro + eoCodes);
          LnedMenu := mpShow;
        End;
    6 : Begin
          S := Trim (GetAnswer ('||' + lang (laDelLines), 20, ofAllowEmpty, ''));
          If Trim (S) = '' Then iAnalyze := True;
          LnedMenu := mpDeleteLine;
        End;
  End;
End;

Begin
  F := True;

  Repeat
    i := MenuBar ('|\11[S]ave, [Q]uit, [C]ontinue, [E]dit line, [L]ist, [D]elete: ', 'SQCELD');
  {$IFDEF WIN32}
    If Application. Terminated Then Exit;
  {$ENDIF}
    iAnalyze;
  Until F;
End;

Procedure EditLine (Var S: String);
Begin
  S := GetAnswer ('', 73, 0, S);
End;

Type
  AttrType = (RO, Hid, Sys, Vol, Dir, Arc);

Const
  AttrText      : Array [AttrType] Of Char = ('r', 'h', 's', 'v', 'd', 'a');
  AttrVal       : Array [AttrType] Of Byte = (1, 2, 4, 8, 16, 32);

Var
  CurDirectory          : PathStr;
  ResStr                : String [100];
  ProcExit              : Boolean;

Procedure ColdBoot;
{$IFNDEF OS2}
Assembler;
Asm
  XOr AX, AX
  mov DS, AX
  mov AH, $40
  mov ES, AX
  mov Word Ptr ES:$72, 0
  mov AX, $FFFF
  mov ES, AX
  XOr SI, SI
  push AX
  push SI
  retf
{$ELSE}
Begin
{$ENDIF}
End;

Function CheckDrive (Command: String): Boolean;
Begin
  CheckDrive := True;

  If (Command [1] in ['A'..'Z', 'a'..'z']) And
     (Command [2] = ':') And
     (DW. Drives [UpCase (Command [1])] > R. Security) Then
  Begin
    ComWrite (#10+lang (laSecurityLow)+#10, eoMacro + eoCodes);
    CheckDrive := False;
    Exit;
  End;
End;

Procedure CdCommand (Command: String);
Var
  CurDir        : PathStr;

Begin
  Command := Trim (Command);
  If Not CheckDrive (Command) Then Exit;

  GetDir (0, CurDir);

  SmartChDir (Command);
  If IOResult <> 0 Then
  Begin
    ComWriteLn (EmuColor ($0C) + #10 + Command + ' directory is invalid.', 0);
    SmartChDir (CurDir);
    Exit;
  End;

  GetDir (0, CurDirectory);
  CurDirectory := UpString (CurDirectory);
  ResStr := 'Directory changed to ' + CurDirectory;
  ComWriteLn (EmuColor ($03) + #10 + ResStr, 0);
  LogWrite ('+', 'DoorWay: ' + ResStr);
End;

Procedure ClsCommand (command: String);
Begin
  ComWrite (EmuColor ($07) + EmuCls, 0);
End;

Procedure TREECommand (Command: String);
Var
  Dir   : DirStr;
  Ext   : ExtStr;
  Name  : NameStr;

Label
  1;

Function LastDir (SRec : {$IFNDEF WIN32} SearchRec {$ELSE} TSearchRec {$ENDIF}) : Boolean;
Var
  ErrorDos      : Integer;
  LDir          : Boolean;

Begin
  ErrorDos := DosError;
  LDir := True;
{$IFDEF WIN32}
  DOSerror :=
{$ENDIF}
  FindNext (SRec);

  While (DosError = 0) And LDir Do
  Begin
    LDir := (SRec. Attr And Directory = 0);
{$IFDEF WIN32}
    DOSerror :=
{$ENDIF}
    FindNext (SRec);
  End;

  DosError := ErrorDos;
  LastDir := LDir;
End;

Procedure Tree (Dir : PathStr);

Procedure SearchDir (Dir, GrDir : PathStr);
Var
  SRec  : {$IFNDEF WIN32} SearchRec {$ELSE} TSearchRec {$ENDIF};

Begin
  If ProcExit Then Exit;
  If Dir [Length (Dir) ] <> '\' Then Dir := Dir + '\';
{$IFDEF WIN32}
  DOSerror :=
{$ENDIF}
  FindFirst (Dir + '*.*', Directory, SRec);

  While DosError = 0 Do
  Begin
    If ProcExit Then Exit;
    With SRec Do If (Attr And Directory <> 0) And (Name [1] <> '.') Then
    Begin
      ComWriteLn (EmuColor ($0E) + GrDir + ' ù ' + EmuColor ($07) + Name, 0);

      If Not More Then
      Begin
        ProcExit := True;
        Exit;
      End;

      SearchDir (Dir + Name, GrDir + '   ');
    End;
  {$IFDEF WIN32}
    DOSerror :=
  {$ENDIF}
    FindNext (SRec);
  End;

{$IFNDEF MSDOS}
  FindClose (SRec);
{$ENDIF}
End;

Begin
  ProcExit := False;
  ComWriteLn (EmuColor ($07) + Dir, 0);
  SearchDir (Dir, ' ');
End;

Procedure ScanDirs;
Begin
  InitMore (0);
  SmartChDir (Copy (CurDirectory, 1, 3));
  FSplit ({$IFNDEF WIN32} FExpand {$ELSE} ExpandFileName {$ENDIF} (''), Dir, Name, Ext);
  Tree (Dir);
  SmartChDir (CurDirectory);
  InitMore (0);
  ProcExit := False;
End;

Begin
  ScanDirs;
  ResStr := 'Showing directory tree';
  LogWrite ('+', 'DoorWay: ' + ResStr);
End;

Procedure MdCommand (command: String);
Begin
  Command := Trim (Command);
  If Not CheckDrive (Command) Then Exit;

  MkDir (Command);

  If IOResult <> 0 Then
  Begin
    ComWriteLn (EmuColor ($0C) + #10'Can''t create directory ' + Trim (Command), 0);
    Exit;
  End Else
  Begin
    ResStr := 'Directory ' + Trim (Command) + ' has been created.';
    ComWriteLn (EmuColor ($03) + #10 + ResStr, 0);
    LogWrite ('+', 'DoorWay: ' + ResStr);
  End;
End;

Procedure RdCommand (Command: String);
Begin
  Command := Trim (Command);
  If Not CheckDrive (Command) Then Exit;

  RmDir (Command);

  If IOResult <> 0 Then
  Begin
    ComWriteLn (EmuColor ($0C) + #10'Can''t delete directory ' + Command, 0);
    Exit;
  End Else
  Begin
    ResStr := 'Directory ' + Trim (Copy (Command, Pos (' ', Command), 255)) + ' deleted.';
    ComWriteLn (EmuColor ($03) + #10 + ResStr, 0);
    LogWrite ('+', 'DoorWay: ' + ResStr);
  End;
End;

Procedure BootCommand (Command: String);
Begin
{$IFDEF MSDOS}
  If TimeTask. Task. OS = 0 Then
  Begin
    ComWriteLn ('\15Shuting down system ...', eoCodes);
    LogClose; mL_Done; EraseFlag (RunFlag); ColdBoot;
  End Else
{$ENDIF}
    ComWriteLn ('\12Cannot reboot system under multitasking evironment!', eoCodes);
End;

Procedure DirCommand (Command: String);
Var
  Sr           : {$IFNDEF WIN32} SearchRec {$ELSE} TSearchRec {$ENDIF};
  DT           : DateTime;
  C            : PDirSortedCollection;
  S            : String;
  TotalSize, i,
  FilesCount,
  DirsCount    : LongInt;
  Aborted      : Boolean;

Procedure ShowDateTime;
Begin
  UnpackTime (SR. Time, DT);

  With DT Do
  S := S +
       EmuColor ($09) + LeftPadCh (Long2Str (Day), '0', 2) + '-' +
       LeftPadCh (Long2Str (Month), '0', 2) + '-' + Copy (Long2Str (Year), 3, 2) + ' ' +
       EmuColor ($0C) + LeftPadCh (Long2Str (Hour), '0', 2) + ':' +
       LeftPadCh (Long2Str (Min), '0', 2) + ' ';
End;

Procedure ShowSize;
Begin
  If (SR. Attr And AttrVal [Vol]) = AttrVal [Vol] Then S := #1 + S + EmuColor ($0B) + '<VolLabel>' Else
  If (SR. Attr And AttrVal [Dir]) = AttrVal [Dir] Then
  Begin
    S := #2 + S + EmuColor ($0B) + '    <DIR> ';
    Inc (DirsCount);
  End Else
  If (SR. Attr And AttrVal [Vol]) <> AttrVal [Vol] Then
  Begin
    S := #3 + S + EmuColor ($0A) + LeftPadCh (Long2Str (SR. Size), ' ', 9) + ' ';
    Inc (FilesCount);
  End;
End;

Function ItemColor (C: Char): String;
Begin
  Case S [1] Of
    #1 : ItemColor := EmuColor ($0F);
    #2 : ItemColor := EmuColor ($0F);
    #3 : ItemColor := EmuColor ($03);
  End;
End;

Function SplitSize (S: String): String;
Var
  i, j  : Byte;
  S1    : String;

Begin
  j := 0;
  S1 := '';

  For i := Length (S) DownTo 1 Do
  Begin
    S1 := S [i] + S1;
    Inc (j);
    If (j = 3) And (i > 1) Then
    Begin
      S1 := '\15,\10' + S1;
      j := 0;
    End;
  End;

  SplitSize := S1;
End;

Begin
  InitMore (0);

  Command := Trim (Command);
  If Command = '' Then Command := '*.*';
  Command := CompletePath (JustPathName (Command)) + JustFileName (Command);
  If Not CheckDrive (Command) Then Exit;

  ComWriteLn (EmuColor ($0A) + #10'Directory of ' + UpString (Command) + #13#10, 0);
  Inc (MoreLines, 2);
  C := New (PDirSortedCollection, Init (5, 5));
  TotalSize := 0;
  FilesCount := 0;
  DirsCount := 0;
  Aborted := False;

{$IFDEF WIN32}
  DOSerror :=
{$ENDIF}
  FindFirst (Command, AnyFile, Sr);
  While DosError = 0 Do
  Begin
    With Sr Do
    Begin
      If Not LongNames Then
      Begin
        S := '';
        ShowSize;
        ShowDateTime;
        Insert (ItemColor (S [1]) + PadCh (Name, ' ', 15), S, 2);
      End Else
      Begin
        S := '';
        ShowDateTime;
        ShowSize;
        S := S + ' ' + ItemColor (S [1]) + Name;
      End;

      C^. Insert (NewStr (S));
      Inc (TotalSize, Size);
    End;

  {$IFDEF WIN32}
    DOSerror :=
  {$ENDIF}
    FindNext (SR);
  End;

{$IFNDEF MSDOS}
  FindClose (SR);
{$ENDIF}

  If C^. Count = 0 Then ComWriteLn (EmuColor ($0C) + 'No files found', 0) Else
  Begin
    For i := 0 To C^. Count-1 Do
    Begin
      S := GetStr (C^. At (i));
      ComWriteLn (Copy (S, 2, 255), 0);

      If Not More Then
      Begin
        Aborted := True;
        Break;
      End;
    End;

    If Not Aborted Then
    Begin
      ComWrite ('|\10' + LeftPadCh (Long2Str (FilesCount), ' ', 12) + ' \15file(s)\10', eoCodes+eoMacro);
      mWriteLen (SplitSize (Long2Str (TotalSize)), 16, pmPadLeft);
      ComWriteLn (' \15bytes', eoCodes+eoMacro);

      ComWrite ('\10' + LeftPadCh (Long2Str (DirsCount), ' ', 13) + ' \15dir(s)\10', eoCodes+eoMacro);
      mWriteLen (SplitSize (Long2Str (DiskFree (0))), 16, pmPadLeft);
      ComWriteLn (' \15bytes free', eoCodes+eoMacro);
    End;
  End;

  While C^. Count > 0 Do
  Begin
    DisposeStr (C^. At (0));
    C^. AtDelete (0);
  End;

  Dispose (C, Done);
  ResStr := 'Showing directory of ' + Trim (NiceFileName (Command, 30));
  LogWrite ('+', 'DoorWay: ' + ResStr);
End;

Procedure DelCommand (Command: String);
Var
  Sr               : {$IFNDEF WIN32} SearchRec {$ELSE} TSearchRec {$ENDIF};
  F                : File;
  Found            : Boolean;
  i                : Byte;
  Pth, S, NiceName : PathStr;

Begin
  If Not CheckDrive (Command) Then Exit;
  ComWriteLn ('', 0);
  Found := False;

  For i := 1 To WordCount (Command, [' ']) Do
  Begin
    S := ExtractWord (i, Command, [' ']);
    Pth := CompletePath (JustPathName (S));

  {$IFDEF WIN32}
    DOSerror :=
  {$ENDIF}
    FindFirst (S, AnyFile-Directory{$IFNDEF OS2}-VolumeID{$ENDIF}, Sr);

    If DosError <> 0 Then
    Begin
    {$IFNDEF MSDOS}
      FindClose (SR);
    {$ENDIF}
      Continue;
    End;

    Found := True;

    While DosError = 0 Do
    Begin
      S := Pth + Sr. Name;
      NiceName := Trim (NiceFileName (S, 50));

      Assign (F, S);
    {$IFNDEF WIN32}
      SetFAttr (F, 0);
    {$ELSE}
      SetFileAttributes (@Sr. Name, 0);
    {$ENDIF}
      Erase (F);

      If IOResult <> 0 Then ComWriteLn (EmuColor ($0C) + 'Can''t delete ' + NiceName, 0) Else
      Begin
        ResStr := NiceName + ' deleted.';
        ComWriteLn (EmuColor ($03) + ResStr, 0);
        LogWrite ('+', 'DoorWay: ' + ResStr);
      End;
    {$IFDEF WIN32}
      DOSerror :=
    {$ENDIF}
      FindNext (Sr);
    End;

  {$IFNDEF MSDOS}
    FindClose (Sr);
  {$ENDIF}
  End;

  If Not Found Then ComWriteLn (EmuColor ($0C) + 'No file(s) found.', 0);
End;

Procedure RenCommand (Command: String);
Var
  F1, F2 : PathStr;

Begin
  F1 := Trim (ExtractWord (1, Command, [' ']));
  F2 := Trim (ExtractWord (2, Command, [' ']));
  If Not CheckDrive (F1) Or Not CheckDrive (F2) Then Exit;

  If FileExists (F1) Then
  Begin
    ComWriteLn (EmuColor ($0B) + #10 + Trim (NiceFileName (F1, 30)) + EmuColor ($0C) + ' -> ' +
    EmuColor ($0B) + Trim (NiceFileName (F2, 30)), 0);

    If Not tRenameFile (F1, F2)
    Then
      ResStr := 'Can''t rename ' + Trim (NiceFileName (F1, 30)) + ' to ' + Trim (NiceFileName (F2, 30))
    Else
      ResStr := 'File ' + Trim (NiceFileName (F1, 30)) + ' renamed to ' + Trim (NiceFileName (F2, 30));

    ComWriteLn (EmuColor ($0B) + ResStr, 0);
    LogWrite ('+', 'DoorWay: ' + ResStr);
  End Else
    ComWriteLn (EmuColor ($0C) + #10 + sm (smFile) + F1 + sm (smNotFound), 0);
End;

Procedure CopyCommand (Command: String);
Var
  Fin, Fout, FTemp      : File;
  TempStr, S            : String [100];
  Sr                    : {$IFNDEF WIN32} SearchRec {$ELSE} TSearchRec {$ENDIF};
  Always                : Boolean;
  TempCurDir, F1, F2    : PathStr;

Label
  2, 4;

Begin;
  F1 := ExtractWord (1, Command, [' ']);
  F2 := ExtractWord (2, Command, [' ']);
  If Not CheckDrive (F1) Or Not CheckDrive (F2) Then Exit;

  Always := False;
  ComWriteLn ('', 0);

{$IFDEF WIN32}
  DOSerror :=
{$ENDIF}
  FindFirst (F1, AnyFile-Directory{$IFNDEF OS2}-VolumeID{$ENDIF}, Sr);

  If DosError = 18 Then
  Begin
    ComWriteLn (EmuColor ($0C) + 'No file(s) found.', 0);
  {$IFNDEF MSDOS}
    FindClose (Sr);
  {$ENDIF}
    Exit;
  End;

  While DosError = 0 Do
  Begin
    TempStr := F2;

    If TempStr [Length (TempStr) ] <> '\' Then
    Begin
      Assign (FTemp, TempStr + '\copy.$$$');
      Rewrite (FTemp, 1);
      If IOResult = 0 Then
      Begin
        TempStr := TempStr + '\' + Sr. Name;
        Close (FTemp);
        Erase (FTemp);
      End;
    End Else
    Begin
      GetDir (0, TempCurDir);
      TempStr := Copy (TempStr, 1, Length (TempStr)-1);
      SmartChDir (TempStr);
      If IOResult <> 0 Then MkDir (TempStr);
      TempStr := TempStr + '\' + Sr. Name;
      SmartChDir (TempCurDir);
    End;

    Assign (Fin, AddBackSlash (JustPathName (F1)) + Sr. Name);
    Assign (Fout, TempStr);

    System. FileMode := Open_Access_ReadOnly;
    Reset (Fin, 1);
    System. FileMode := Open_Access_ReadWrite;

    If IOResult <> 0 Then
    Begin
      ComWriteLn (EmuColor ($0C) + 'Can''t open source file ' + Sr. Name, 0);
      Goto 2;
    End;

    Reset (Fout, 1);

    If IOResult = 0 Then
    Begin
      If Always = True Then
      Begin
        Close (FOut);
        Goto 4;
      End;

      i := MenuBar (EmuColor ($0B) + 'File ' + TempStr +
      ' already exists. Overwrite it? (Yes/No/All/Cancel): ',
      'YNCA');
    {$IFDEF WIN32}
      If Application. Terminated Then Exit;
    {$ENDIF}

      Case i Of
        1: Begin
             Close (Fout);
             ComWriteLn (EmuColor ($0B), 0);
             Goto 4;
           End;

        2: Begin
             Close (FOut);
             ComWriteLn (EmuColor ($0B), 0);
             Goto 2;
            End;

        3: Begin
             Close (FOut);
             Close (FIn);
             ComWriteLn (EmuColor ($0B), 0);
             If IOResult <= 65535 Then Exit;
           End;

        4: Begin
             Close (FOut);
             Always := True;
             ComWriteLn (EmuColor ($0B), 0);
             Goto 4;
           End;
      End;
    End;

    4:
    Rewrite (Fout, 1);

    If IOResult <> 0 Then
    Begin
      ComWrite (EmuColor ($0C) + 'Can''t open target file ' + TempStr, 0);
      Close (Fin);
      Goto 2;
    End;

    Close (Fin);
    Close (Fout);

    S := AddBackSlash (JustPathName (F1)) + Sr. Name;

    ComWrite (lang (laCopyFile), eoCodes+eoMacro);
    ComWrite (Trim (NiceFileName (S, 45)), 0);
    ComWrite (lang (laCopyTo), eoCodes+eoMacro);
    ComWriteLn (Trim (NiceFileName (TempStr, 45)) + '...', 0);

    tCopyFile (S, TempStr, True);

    If DrawAborted Then Break;

    2:
  {$IFDEF WIN32}
    DOSerror :=
  {$ENDIF}
    FindNext (Sr);
  End;

  If DOSError <> 0 Then ComWriteLn (lang (laCopyDone), eoMacro + eoCodes);
{$IFNDEF MSDOS}
  FindClose (Sr);
{$ENDIF}

  LogWrite ('+', 'DoorWay: file(s) ' + F1 + ' copied to ' + F2);
End;

Procedure ShellCommand (Command: String);
Var
  F             : Text;
  TempStr       : String;
{$IFDEF MSDOS}
  Status        : Word;
{$ENDIF}

Begin
{$IFDEF MSDOS}
  ComWrite (EmuColor ($03) + #10'Swapping ... ', 0);
  UseEmsIfAvailable := True;

  If Not InitExecSwap (HeapPtr, Cnf. TempDir + DelChars ([':'], StrTime) + 'sh.swp') Then
  Begin
    ComWriteLn (EmuColor ($0c) + 'Unable to allocate swap space!', 0);
    Exit;
  End Else
    ComWrite (#13, 0);

  ComWrite ('Executing. Wait, please ...'#13, 0);
  If Not Local Then DeactivatePort (P, True);

  SwapVectors;
  Status := ExecWithSwap (GetEnv ('COMSPEC'), ' /c ' + Command + ' >' + Cnf. TempDir + 'torshell.$$$');
  SwapVectors;

  ShutDownExecSwap;
  If Not Local Then ActivatePort (P, True);
  SetBlink (Cnf. Blinking);

  If StatusBar And (WhereY >= ScrY) Then
  Begin
    GoToXY (1, ScrY-1);
    ComWrite (EmuClrEOL, 0);
  End;

  If Status <> 0 Then
  Begin
    ComWriteLn (EmuColor ($0C) + 'Unable to execute.', 0);
    Exit;
  End;
{$ELSE}
  DosShell (Command + ' >' + Cnf. TempDir + 'torshell.$$$', True, True);
{$ENDIF}

  Assign (F, Cnf. TempDir + 'torshell.$$$');
  Reset (f);
  InitMore (0);
  ComWrite (EmuColor (3), 0);

  While Not SeekEof (f) Do
  Begin
    ReadLn (F, TempStr);
    ComWriteLn (TempStr, 0);
    If Not More Then Break;
  End;

  Close (f);
  Erase (f);

  If IOResult <> 0 Then ComWriteLn (EmuColor ($03) + 'No information received from the program.', 0);
  LogWrite ('+', 'DoorWay: exec shell "' + Trim (Command) + '"');
End;

Procedure DateCommand (Command: String);
Var
  NewDate               : String;
  Month, Day, Year      : Word;

Label
  5;

Begin
  {ComWriteLn (EmuColor ($0C) + #10'This command doesn''t work yet.', 0);
  Exit;}

  ComWriteLn (EmuColor ($0B) + 'Current date is: ' + ReFormatDate (StrDate, 'DD-MM-YYYY', 'DD-MM-YY'), 0);

  NewDate := '';
  While Not DateMaskMatch (NewDate, Cnf. DateMask) Do
  Begin
    ComWrite ('Enter new date in format (' + Cnf. DateMask + ') : ', 0);
    NewDate := '';
    ComReadLn (NewDate, 10, ofAllowEmpty);
    NewDate := Trim (NewDate);
  {$IFDEF WIN32}
    If Application. Terminated Then Exit;
  {$ENDIF}
    If NewDate = '' Then Exit;
  End;

  ExtractDate (NewDate, Cnf. DateMask, Year, Month, Day);

  Dec (R. TotalTime, MidSec-EnterTime);
{$IFNDEF WIN32}
  SetDate (Year, Month, Day);
{$ENDIF}
  EnterTime := MidSec;

  ComWriteLn (EmuColor ($0F) + 'Current date is: ' + ReFormatDate (StrDate, 'DD-MM-YYYY', Cnf. DateMask), 0);
  LogWrite ('+', 'DoorWay: date changed, new date is ' + ReFormatDate (StrDate, 'DD-MM-YYYY', Cnf. DateMask));
End;

Procedure TimeCommand (Command: String);
Var
{$IFNDEF WIN32}
  Hour, Min, Sec             : Word;
{$ENDIF}
  Point                      : SysInt;
  StrHour, StrMin, StrSec, S : String;

Begin
  {ComWriteLn (EmuColor ($0C) + #10'This command doesn''t work yet.', 0);
  Exit;}

  ComWriteLn (EmuColor ($03) + #10'Current time is ' + StrTime, 0);
  ComWrite ('Enter new time: ' + EmuColor ($0F), 0);
  S := '';
  ComReadLn (S, 10, ofAllowEmpty);
{$IFDEF WIN32}
  If Application. Terminated Then Exit;
{$ENDIF}
  If S = '' Then Exit;

  StrHour := ExtractWord (1, S, [':']);
  StrMin := ExtractWord (2, S, [':']);
  StrSec := ExtractWord (3, S, [':']);

  If ConsistsOf (StrHour, ['0'..'9']) And
     ConsistsOf (StrMin, ['0'..'9']) And (
     ConsistsOf (StrSec, ['0'..'9']) Or (
     StrSec = '')) Then
  Begin
    Dec (R. TotalTime, MidSec-EnterTime);
  {$IFNDEF WIN32}
    SetTime (Str2Long (StrHour), Str2Long (StrMin), Str2Long (StrSec), 0);
  {$ENDIF}
    EnterTime := MidSec;
  End Else
    ComWriteLn (EmuColor ($0C) + 'Entered time is invalid.', 0);

  LogWrite ('+', 'DoorWay: system time set to ' + StrTime);
End;

Procedure DirSizeCommand (Command: String);
Var
  Temp          : LongInt;
  TempStr       : PathStr;

Begin
  If Not CheckDrive (Command) Then Exit;

  GetDir (0, TempStr);
  SmartChDir (Command);

  If IOResult <> 0 Then
  Begin
    SmartChDir (TempStr);
    ComWriteLn (EmuColor ($0E) + Command + ' directory is invalid.', 0);
    Exit;
  End;

  ComWrite (EmuColor ($03) + #10'Calculating. Please, wait ...', 0);
  SmartChDir (TempStr);
  Temp := DirSizeWSb (Command);
  SmartChDir (TempStr);

  ComWriteLn (EmuColor ($0A) + #13'Total size of ' +
  CompletePath (Command) + ' contents is ' +
  Long2Str (Temp) + ' bytes.', 0);
End;

Procedure xDelCommand (Command: String);
Var
  TempStr       : PathStr;

Label
   4;

Begin
  If Not CheckDrive (Command) Then Exit;

  GetDir (0, TempStr);
  SmartChDir (Command);

  If IOResult <> 0 Then
  Begin
    ComWriteLn (EmuColor ($0E) + Command + ' directory is invalid.', 0);
    Exit;
  End;

  SmartChDir (TempStr);

  If Query ('\12Are you sure you want to do recursive deleting?', False, ofFramed)
     Then Goto 4
     Else Exit;

  4:
  ComWriteLn (EmuColor ($0E) + 'Deleting. Wait ...', 0);
  DelWithSubDirs (Command);
  SmartChDir (TempStr);
  LogWrite ('+', 'DoorWay: directory ' + Command + ' deleted with subdirs');
End;

Procedure DlCommand (Command: String);
Var
  oF2Transfer   : PTagFilesCollection;
  DirInfo       : {$IFNDEF WIN32} SearchRec
                  {$ELSE} TSearchRec {$ENDIF};
  FileRec       : TTagFileRec;
  i             : Byte;
  Found         : Boolean;
  oSizeOfAll    : LongInt;
  Dir           : PathStr;

Begin
  oF2Transfer := New (PTagFilesCollection, Init (10, 1));
  GetDir (0, Dir);
  Dir := AddBackSlash (Dir);

  If F2Transfer^. Count > 0 Then
  For i := 0 To F2Transfer^. Count-1
  Do oF2Transfer^. Insert (NewTagFile (PTagFileRec (F2Transfer^. At (i))^));

  F2Transfer^. DeleteAll;
  oSizeOfAll := SizeOfAll;
  SizeOfAll := 0;
  Found := False;

  For i := 1 To WordCount (Command, [' ', ',']) Do
  Begin
    If Not CheckDrive (ExtractWord (i, Command, [' '])) Then Continue;

  {$IFDEF WIN32}
    DOSerror :=
  {$ENDIF}
    FindFirst (ExtractWord (i, Command, [' ']), AnyFile-Directory{$IFNDEF OS2}-VolumeID{$ENDIF}, DirInfo);

    If DOSError <> 0 Then
    Begin
    {$IFNDEF MSDOS}
      FindClose (DirInfo);
    {$ENDIF}
      Continue;
    End;

    While DOSError = 0 Do
    Begin
      Found := True;
      FileRec. PathName   := Dir + DirInfo. Name;
      FileRec. AreaNum    := 0;
      FileRec. Size       := DirInfo. Size;
      FileRec. FromName   := '';

      If Not InTagList (FileRec. PathName) Then
      Begin
        F2Transfer^. Insert (NewTagFile (FileRec));
        Inc (SizeOfAll, DirInfo. Size);
      End;
    {$IFDEF WIN32}
      DOSerror :=
    {$ENDIF}
      FindNext (DirInfo);
    End;

  {$IFNDEF MSDOS}
    FindClose (DirInfo);
  {$ENDIF}

  End;

  If Not Found Then ComWriteLn (EmuColor ($0C) + 'No files found', 0) Else
  Begin
    UpdateUserMacro;

    AutoDL := True;
    Transfer ('', Transmit, tsNormal);
    AutoDL := False;
  End;

  While oF2Transfer^. Count > 0 Do
  Begin
    F2Transfer^. Insert (NewTagFile (PTagFileRec (oF2Transfer^. At (0))^));
    DisposeTagFile (oF2Transfer^. At (0));
    oF2Transfer^. AtDelete (0);
  End;

  Dispose (oF2Transfer, Done);
  SizeOfAll := oSizeOfAll;
  UpdateUserMacro;
End;

Procedure UlCommand (Command: String);
Var
  oProtocol     : Char;

Begin
  oProtocol := R. Protocol;
  R. Protocol := '7';

  AutoDL := True;
  Transfer ('', Receive, tsNormal);
  AutoDL := False;

  R. Protocol := oProtocol;
End;

Procedure ArcViewCommand (Command: String);
Begin
  Command := Trim (Command);
  If Not CheckDrive (Command) Then Exit;

  If IsDevice (JustFileName (Command)) Or Not FileExists (Command) Then
  Begin
    ComWrite ('|\12' + lang (laFileName), eoCodes+eoMacro);
    ComWrite (Command, 0);
    ComWrite (lang (laNotFound), eoCodes+eoMacro);
    If InShell Then ComWriteLn ('', 0) Else Message ('');
  End Else
    OnLineArcView (Command);
End;

Procedure EditCommand (Command: String);
Var
  C        : Char;
  SaveFile : Boolean;

Begin
  Command := Trim (Command);
  If Not CheckDrive (Command) Then Exit;

  If IsDevice (JustFileName (Command)) Or (Not FileExists (Command)) Then
  Begin
    ComWrite ('|\12' + lang (laFileName) + Command + lang (laNotFound), eoCodes+eoMacro);
  End Else
  Begin
    SaveFile := False;
    tCopyFile (Command, Cnf. DoorInfoDir + 'msgtmp.', True);

    If R. Emu = teTTY Then SaveFile := lnEditFile (Cnf. DoorInfoDir + 'msgtmp.', LnedMenu, EditLine, $03, $03) = mpSave Else
    Begin
      ComWrite (EmuGoToXY (1, 23), 0);
      ComWrite ('\09ÄÄ\15[ \10' + NiceFileName (CompletePath (JustPathName (Command)) + Command, 42) +
      ' \15]\09ÄÄ\15[\14^\11Z \15Ä \11save\15]\09ÄÄ\15[\14E\11sc \15Ä \11abort\15]\09ÄÄ', eoCodes);

      While True Do
      Begin
        C := fsEditFile (Cnf. DoorInfoDir + 'msgtmp.', [#27, #26], 0, $03, $03, 1, 1, 79, 22);
      {$IFDEF WIN32}
        If Application. Terminated Then Exit;
      {$ENDIF}

        Case C Of
            #27 : Begin
                    ComWrite (EmuGoToXY (1, 22), 0);
                    ComWrite (EmuClrEOL, 0);
                    If Query (lang (laSure), False, ofNoCR) Then Break;
                  End;
            #26 : Begin
                    SaveFile := True;
                    Break;
                  End;
        End;
      End;

      Cls;
    End;

    If SaveFile Then tRenameFile (Cnf. DoorInfoDir + 'msgtmp.', Command);
  End;
End;

Procedure TypeCommand (Command: String);
Begin
  Command := Trim (Command);
  If Not CheckDrive (Command) Then Exit;

  ComWriteLn ('', 0);
  TypeFile (Command);
End;

Procedure LocateCommand (Command: String);
Begin
  Command := Trim (Command);
  If Not CheckDrive (Command) Then Exit;

  InitMore (1);
  ComWriteLn (EmuColor ($0A), 0);
  fLocate (Command, WFileName);
End;

Procedure TaskListCommand (Command: String);
{$IFDEF OS2}
Type
  Asshole = ^Byte;

Var
   aHab                 : Hab;
   NumItems, Status     : ULong;
   TskLst, TaskList     : PswBlock;
   TaskListSize         : Integer;
{$ENDIF}

Begin
{$IFDEF OS2}
  aHab:= NULLHANDLE;

  { ¯®èãª ¥¬ áª®«ìª® ¯ ¬ïâ¨ ­ ¤® ¯®¤ TaskList }

  NumItems := WinQuerySwitchList (aHab, nil, 0);

  If NumItems < 1 Then
  Begin
    ComWriteLn (EmuColor ($0C) + 'Can''t get task list without PMSHELL running.', 0);
    Exit;
  End;

  ComWriteLn (#10 + EmuColor ($09) + Long2Str (NumItems) + ' items in the Task List.'#10, 0);
  TaskListSize := (NumItems * SizeOf (SWENTRY)) + SizeOf (HSWITCH);
  GetMem (TaskList, TaskListSize);

  {­ ¤® ¤®¡ ¢¨âì ¯p®¢¥p®çªã, ¬®¦¥â ¯ ¬ïâ¨ ¡®«ìè¥ ­¥âã ;) }

  If TaskList = Nil Then
  Begin
    ComWriteln (EmuColor ($0C) + 'Unable to allocate memory for tasklist!', 0);
    Exit;
  End;

  {â¥¯¥pì ¬®¦­® § ¯®«ãç¨âì á ¬ TaskList}

  Status := WinQuerySwitchList (aHab, TaskList, TaskListSize);

  If Status = 0 Then
  Begin
    ComWriteLn ('\12Could not query Task List', eoCodes);
    Exit;
  End;

  TskLst := TaskList;

  { á®åp ­ï¥¬ áâ pë© ãª § â¥«ì }

  ComWriteLn (EmuColor ($0E) + '  PID   Process title', 0);
  ComWriteLn (EmuColor ($0F) + 'ÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄÄ', 0);

  For Status := 1 To NumItems Do
  Begin
    ComWriteLn (EmuColor ($0C) + '[' + EmuColor ($03) + LeftPadCh (Long2Str
               (TaskList^. aSwentry. SwCtl. idProcess), ' ', 5) + EmuColor
               ($0C) + '] ' + EmuColor ($0B) + PlaceSubStr (Copy
               (TaskList^. aSwentry. SwCtl. szSwtitle, 1, Pos
               (#0, TaskList^. aSwentry. SwCtl. szSwtitle)), #10, ' '), 0);

    Inc (Asshole (TaskList), SizeOf (SWENTRY));
  End;

  FreeMem (TskLst, TaskListSize);
{$ELSE}

{$ENDIF}
End;

Procedure KillCommand (Command: String);
{$IFDEF OS2}
Var
  Status        : ApiRet;
{$ENDIF}

Begin
{$IFDEF OS2}
  Command := Trim (Command);
  Status := DosKillProcess (dkp_Process, Str2Long (Command));

  If Status = 0
  Then ComWriteLn (EmuColor ($03) + #10'The process killed successfully.', 0)
  Else ComWriteLn (EmuColor ($0C) + #10'Error killing the process specified.', 0)
{$ELSE}
{$ENDIF}
End;

Procedure HelpCommand (Command: String); Forward;

Type
  tCommandProc = Procedure (Command: String);

  tcInfoRec = Record
    C : String [15];
    Desc, Use : String [70];
    Proc : tCommandProc;
    ArgCount : Byte;
  End;

Const
  CommandInfo : Array [hcCls..hcKill] Of tcInfoRec = (

    (C: 'CLS';
     Desc: 'Clears the screen.';
     Use: '';
     Proc: CLScommand;
     ArgCount: 0),

    (C: 'CD';
     Desc: 'Changes current directory.';
     Use: 'CD [drive][path]';
     Proc: CDcommand;
     ArgCount: 1),

    (C: 'DIR';
     Desc: 'Displays directory contents.';
     Use: 'DIR [drive][path][wildcard]';
     Proc: DirCommand;
     ArgCount: 0),

    (C: 'TREE';
     Desc: 'Displays the directory tree of current disk.';
     Use: '';
     Proc: TreeCommand;
     ArgCount: 0),

    (C: 'MKDIR';
     Desc: 'Makes directory with the name specified.';
     Use: 'MKDIR [drive][dirname]';
     Proc: MDCommand;
     ArgCount: 1),

    (C: 'RMDIR';
     Desc:  'Removes directory specified.';
     Use: 'RMDIR [drive][path]';
     Proc: RDCommand;
     ArgCount: 1),

    (C: 'DIRSIZE';
     Desc: 'Calculates size of the directory contents.';
     Use: 'DIRSIZE [drive][path]';
     Proc: DirSizeCommand;
     ArgCount: 1),

    (C: 'DEL';
     Desc: 'Deletes file(s) specified.';
     Use: 'DEL [wildcard1] [wildcard2] ...';
     Proc: DelCommand;
     ArgCount: 1),

    (C: 'REN';
     Desc: 'Renames or moves fromfile to tofile.';
     Use: 'REN [fromfile] [tofile]';
     Proc: RenCommand;
     ArgCount: 2),

    (C: 'COPY';
     Desc: 'Copies file(s).';
     Use: 'COPY [fromfilewildcard] [topath]';
     Proc: CopyCommand;
     ArgCount: 2),

    (C: 'ARCVIEW';
     Desc: 'Displays contents of the arcived file specified.';
     Use: 'ARCVIEW [drive][path][archived file name]';
     Proc: ArcViewCommand;
     ArgCount: 1),

    (C: 'TYPE';
     Desc: 'Displays text file.';
     Use: 'TYPE [drive][path][filename]';
     Proc: TypeCommand;
     ArgCount: 1),

    (C: 'LOCATE';
     Desc: 'Searches for files matching wildcard specified.';
     Use: 'LOCATE [wildcard]';
     Proc: LocateCommand;
     ArgCount: 1),

    (C: 'SHELL';
     Desc: 'Runs the program specified.';
     Use: 'SHELL [command line]';
     Proc: ShellCommand;
     ArgCount: 1),

    (C: 'BOOT';
     Desc: 'Reboots the system.';
     Use: '';
     Proc: BootCommand;
     ArgCount: 0),

    (C: 'DATE';
     Desc: 'Changes system date.';
     Use: 'DATE [new date]';
     Proc: DateCommand;
     ArgCount: 0),

    (C: 'TIME';
     Desc: 'Changes system time.';
     Use: 'TIME [new time]';
     Proc: TimeCommand;
     ArgCount: 0),

    (C: 'XDEL';
     Desc: 'Deletes directory with all the subdirs.';
     Use: 'XDEL [drive][path]';
     Proc: xDelCommand;
     ArgCount: 1),

    (C: 'UL';
     Desc: 'Uploads file(s) into current directory.';
     Use: '';
     Proc: ULCommand;
     ArgCount: 0),

    (C: 'DL';
     Desc: 'Downloads file(s) specified.';
     Use: 'DL [file1] [file2] ...';
     Proc: DLCommand;
     ArgCount: 1),

    (C: 'EDIT';
     Desc: 'Invokes internal editor to edit the text file specified.';
     Use: 'EDIT [filename]';
     Proc: EditCommand;
     ArgCount: 1),

    (C: 'EXIT';
     Desc: 'Exits internal Tornado DoorWay.';
     Use: '';
     Proc: nil;
     ArgCount: 0),

    (C: 'TASKLIST';
     Desc: 'Displays list of the programs currently running.';
     Use: '';
     Proc: TaskListCommand;
     ArgCount: 0),

    (C: 'KILL';
     Desc: 'Kills the task specified.';
     Use: 'KILL [pid]';
     Proc: KillCommand;
     ArgCount: 1)

  );

Procedure HelpCommand (Command: String);
Var
  h    : tDoorWayCommands;
  i, j : Byte;

Begin
  Command := UpString (Trim (Command));

  If Command = '' Then
  Begin
    ComWriteLn ('', 0);
    ComWriteLn ('\15Tornado DoorWay supported commands', eoCodes);
    ComWriteLn ('\08ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ', eoCodes);
    ComWriteLn (EmuColor ($07), 0);

    j := 0;
    For i := Byte (hcCls) To Byte (hcKill) Do
    Begin
      Inc (j);
      ComWrite (PadCh (CommandInfo [tDoorWayCommands (i)]. C, ' ', 10), 0);
      If j = 6 Then
      Begin
        ComWriteLn ('', 0);
        j := 0;
      End;
    End;

    ComWriteLn ('||\12Type HELP <Command> for help on a specified command.', eoCodes);
  End Else

  For h := hcCls To hcKill Do
  If CommandInfo [h]. C = Command Then
  Begin
    ComWriteLn ('\03|' + CommandInfo [h]. Desc, eoCodes);
    If CommandInfo [h]. Use <> '' Then ComWriteLn ('|' + CommandInfo [h]. Use, eoCodes);
    Break;
  End;
End;

Procedure CommandProcessor;

Procedure ParseCommandLine;
Var
  Command, Cmd, Parameter : String;
  cDir                    : PathStr;
  Found                   : Boolean;
  h                       : tDoorWayCommands;

Label
  1, 2;

Begin;
  SetTitle ('doorway');
  1: ComWriteLn ('', 0);
  2: GetDir (0, CurDirectory);
{$IFDEF OS2}
  LongNames := GetDriveType (CurDirectory [1]) = dtHDHPFS;
{$ENDIF}
  CurDirectory := UpString (Trim (NiceFileName (CurDirectory, 55)));
  mL_LineMsg;
  ComWrite (EmuColor ($0F) + CurDirectory + '>' + EmuColor ($07), 0);
  Command := '';
  ComReadLn (Command, 60, ofAllowEmpty+ofHistory);
  Clock2;
{$IFDEF WIN32}
  If Application. Terminated Then Exit;
{$ENDIF}
  Command := Trim (Command);
  If Command = '' Then Goto 2;
  Cmd := UpString (ExtractWord (1, Command, [' ']));
  If Pos (' ', Command) = 0 Then Parameter := '' Else Parameter := Trim (Copy (Command, Pos (' ', Command), 255));

  If (Command [2] = ':') And (Length (Trim (Command)) <= 3) Then {Change drive}
  Begin
    If WordCount (Command, [' ']) <> 1 Then
    Begin
      ComWriteLn (EmuColor ($0C) + #10'Incorrect usage.', 0);
      Goto 1;
    End;

    Command [1] := UpCase (Command [1]);
    If DW. Drives [Command [1]] > R. Security Then
    Begin
      ComWrite (#10+lang (laSecurityLow)+#10, eoMacro + eoCodes);
      Goto 1;
    End;

    GetDir (0, cDir);
    SmartChDir (Command [1] + ':\');

    If IOResult <> 0 Then
    Begin
      ComWriteLn (EmuColor ($0C) + #10'Invalid drive specified or the drive isn''t ready.', 0);
      SmartChDir (cDir);
      Goto 1;
    End;

    ComWriteLn (EmuColor ($03) + #10'Drive changed to ' + Command [1] + ':', 0);
    LogWrite ('+', 'DoorWay: drive changed to ' + Command [1] + ':');
  End Else
  If Cmd = 'EXIT' Then Exit Else
  If Cmd = 'HELP' Then HelpCommand (Parameter) Else
  Begin
    Found := False;

    For h := hcCls To hcKill Do
    If CommandInfo [h]. C = Cmd Then
    Begin
      Found := True;

      If (DW. SecLevel [h] > R. Security) Or Not FlagsValid (R. Flags, DW. SecFlags [h])
      Then ComWriteLn ('|' + lang (laSecurityLow), eoMacro+eoCodes) Else
      If CommandInfo [h]. ArgCount > WordCount (Parameter, [' '])
      Then
        ComWriteLn ('\12|Wrong number of parameters for command \15' +
        Cmd + '\12.|Type \15HELP ' + Cmd + ' \12to see more info about its usage.', eoCodes)
      Else
        CommandInfo [h]. Proc (Parameter);

      Break;
    End;

    If Not Found Then ComWriteLn (EmuColor ($0C) + #10'Unknown command entered.', 0);
  End;

  GoTo 1;
End;

Begin
  InShell := True;
  ReadDoorWay (Cnf. DoorWayCTL, DW);

  If DW. Enter > R. Security Then
  Begin
    Message (lang (laSecurityLow));
    Exit;
  End;

  Cls;
  ComWriteLn (EmuColor ($07) + #13 + Replicate ('Ä', 79), 0);

  ComWriteLn (EmuColor ($0B) + Replicate (' ', 13) + 'Command processor for ' +
              EmuColor ($0E) + 'TORNADO ' + EmuColor ($0B) +
             'communications soft', 0);

  ComWriteLn (EmuColor ($0E) + Replicate (' ', 13) + 'Written by Alex Radzishevskiy & Konstantin Klyagin', 0);
  ComWriteLn (EmuColor ($07) + Replicate ('Ä', 79), 0);
  ComWriteLn (EmuColor ($0F) + ReFormatDate (StrDate, 'DD-MM-YYYY', Cnf. DateMask) + ' ' + StrTime, 0);
  ComWriteLn (EmuColor ($07) + #10'If you need help, type "HELP" or "<command> /?"', 0);
  ClearInputHistory;

  SmartChDir (DW. StartDir);

  If IOResult <> 0
  Then Message (EmuColor ($0E) + DW. StartDir + ' directory is invalid.')
  Else ParseCommandLine;

{$IFDEF WIN32}
  If Application. Terminated Then Exit;
{$ENDIF}
  InShell := False;
End;

Function fTranslateExecParams (S: String): String;
{$IFDEF RACREATE}
{$I INC\struct.250}
{$ENDIF}
Var
  pG      : Byte;
  S1      : String;
{$IFDEF RACREATE}
  RACfg   : CONFIGrecord;
  RAGrp   : GROUPrecord;
  MsgArea : tMsgArea;
  RACfgF  : File of CONFIGrecord;
  RAGrF   : File of GROUPrecord;
Type
  CharSet = Set of Char;

Procedure FlagTOR2RA (TorFlags : String; Var RAFlags : FlagType; Allow : CharSet);
Var
  i, j, k,
  Flag, Bit : Byte;
  A : Byte;

Begin
  If 'A' In Allow Then A := Ord ('A');
  If 'a' In Allow Then A := Ord ('a');
  RAFlags [1] := $00;
  RAFlags [2] := $00;
  RAFlags [3] := $00;
  RAFlags [4] := $00;
  For k := 1 To Length (TorFlags) Do
  Begin
    If TorFlags [k] In Allow Then
    Begin
      i := (Byte ((TorFlags [k])) - A) Div 8;
      j := (Byte ((TorFlags [k])) - i*8 - A);
      Inc (i);
      RAFlags [i] := RAFlags [i] Or ($01 Shl j);
    End;
  End;
End;

Procedure AskTOR2RA (TorAsk : AskType ;Var RAAsk : RAAskType);
Begin
  Case TorAsk Of
  atAsk:
    RAAsk := Ask;
  atYes:
    RAAsk := Yes;
  atNo:
    RAAsk := No;
  End;
End;
{$ENDIF}

Begin
  If Not Local Then
  Begin
  {$IFNDEF OS2}
    S1 := Long2Str (Cnf. ComPort);
  {$ELSE}
    If Copy (Cnf. ComPort, 1, 3) = 'COM' Then S1 := Trim (Copy (Cnf. ComPort, 4, 255));
  {$ENDIF}
  End Else
    S1 := '0';

  If R. Emu in  [teAnsi, teAvatar] Then pG := 1 Else pG := 0;

{$IFDEF RACREATE}
  If StrPosition ('*RA', S, 1) <> 0 Then
  Begin
    S := PlaceSubStr (S, '*RA', '');
    FillChar (RACfg, SizeOf (CONFIGrecord), #0);
    With RACfg Do
    Begin
      VersionID := $0250;
      ExternalEdCmd := Copy (Cnf. ExtMailEd, 1, 60);
      SystemName := Copy (Cnf. BBSName, 1, 30);
      NewSecurity := Cnf. Security;
      FlagTOR2RA (Cnf. Flags, NewFlags, ['A'..'Z']);
      Sysop := Copy (Cnf. SysOp, 1, 35);
      FastLogon := Cnf. FastLogon;
      UserTimeOut := Cnf. InactiveTime;
      LogonTime := Cnf. RegisterTime;
      PasswordTries := Cnf. PassTryes;
      PageLength := Cnf. PageDuration;
      CheckForMultiLogon := True;
      ExcludeSysopFromList := True;
      OneWordNames := Cnf. OneWordNames;
      AskTOR2RA (Cnf. ScanPrivMail,CheckMail);
      AskVoicePhone := Cnf. VoicePhone;
      AskDataPhone := Cnf. DataPhone;
      FixUploadDates := Cnf. AjustULdate;
      FreezeChat := Cnf. ChatTimeSuspend;
      AskTOR2RA (Cnf. ANSI, ANSI);      { ANSI: Yes, no, or ask new users }
      ClearScreen := Yes;               { Clear:        "                 }
      AskTOR2RA (Cnf. More, MorePrompt);{ More:         "                 }
      If (Cnf. PostUpload = atYes) Or
         (Cnf. PostUpload = atAsk) Then UploadMsgs := True;
      KillSent := No;                   { Kill/Sent     "                 }
      If BbsLine <> 0 Then MultiLine := True;
      MinPwdLen := Cnf. PassLength;
      MinUpSpace := Cnf. UploadSpace;
      AskTOR2RA (Cnf. HotKeys, HotKeys);
      WhyPage := Cnf. AskChatTopic;
      LeaveMsg := Str2Long (Cnf. ToSysOpArea);
      ShowMissingFiles := Cnf. FAShowMissing;
      AllowNetmailReplies :=True;
      LogonPrompt := Copy (Cnf. LoginString, 1, 40);
      AskTOR2RA (Cnf. ScanNewFiles, CheckNewFiles);
      AskForHandle := Cnf. AskAlias;
      AskForBirthDate := Cnf. Birthdate;
      If Cnf. eaAvatar Then AVATAR := Yes;
      BadPwdArea := Str2Long (Cnf. ToSysOpArea);
      Location := Copy (Cnf. Location, 1, 40);
      AskTOR2RA (Cnf. FSEditor, FullMsgView);
      EMSI_NewUser := Cnf. IEMSI_Enable;
      EchoChar := 'þ';
      ChatCommand := Copy (Cnf. ExternalChat, 1, 60);
      LangHdr := Copy (Cnf. ChoiceLanguageStr1, 1, 40);
      LanguagePrompt := Copy (Cnf. ChoiceLanguageStr2, 1, 40);
      If Cnf. DetectEmu = ynAuto Then  AutoDetectANSI := True;
      SemPath := Copy (Cnf. FlagsDir, 1, 60);
      AutoChatCapture := True;
      NewFileTag := True;;
      CheckDOB := 1;
      AskForAddress := Cnf. Address;
      AskTOR2RA (Cnf. DLDescs, DLdesc);
      SavePasswords := True;
{      ProtocolAttrib [1] := 1; {      : Array[1..6] of Byte;}
{      ArcInfo             : Array[1..10] of ARCrecord;}
{      ArcViewCmd          : String[60];}
    End;
(*
    If Cnf. MsgGroupsFile <> '' Then
      If OpenMsgGroups Then
      Begin
        OldMG := MsgGroup;
        i := 1;
        While ReadMsgGroup (tMG, i) Do
        Begin
          FillChar (RAGrp, SizeOf (GROUPrecord), #0);
          With RAGrp Do
            AreaNum := i;
            Name := Copy (tMG. Name, 1, 40);
            Security := tMG. ShowSec;
            FreeSpace := tMG. Tag;

                     Flags,
                     NotFlagsMask   : FlagType;
   ShowFlags                       : String [26];



          Inc (i);
        End;
      End;
*)
{
    If OpenMsgAreas Then
    Begin
      i := 1;
      oArea := R. MsgArea;
      oMsgArea := MsgArea;

      While ReadMsgArea (MsgArea, i) Do
      Begin
        Inc (i);
}


 (*
    CloseMsgAreas;
    If OpenMsgAreas Then
    Begin
      If ReadMsgArea (MsgArea, i) Then
      Begin
      End;
      CloseMsgAreas;
    End;
 *)
{      MsgBasePath         : String[60];}
{      Address             : Array[0..9] of NetAddress;}

    Assign (RACfgF, Cnf. DoorInfoDir + 'CONFIG.RA');
    ReWrite (RACfgF);
    Write (RACfgF, RACfg);
    Close (RACfgF);
  End;
{$ENDIF}
{$IFDEF DROPREAD}
  If StrPosition ('*EI', S, 1) <> 0 Then ReReadExitInfo := True;
  S := PlaceSubStr (S, '*EI', ''); {ExitInfo.bbs}
  If StrPosition ('*DI', S, 1) <> 0 Then ReReadDorInfo  := True;
  S := PlaceSubStr (S, '*DI', ''); {DorInfo.def}
  If StrPosition ('*DS', S, 1) <> 0 Then ReReadDoorSys  := True;
{$ENDIF}
  S := PlaceSubStr (S, '*DS', ''); {Door.sys}
  S := PlaceSubStr (S, '*P', S1);
  S := PlaceSubStr (S, '*N', Long2Str (BbsLine));
  S := PlaceSubStr (S, '*B', Long2Str (GetConnectSpeed));
  S := PlaceSubStr (S, '*G', Long2Str (pG));
  S := PlaceSubStr (S, '*F', ExtractWord (1, R. Name, [' ']));

  If WordCount (R. Name, [' ']) > 1
  Then
    S1 := ExtractWord (WordCount (R. Name, [' ']), R. Name, [' '])
  Else
    S1 := '';

  S := PlaceSubStr (S, '*L', S1);
  S := PlaceSubStr (S, '*T', Long2Str (Round ((R. TotalTime-(MidSec-EnterTime))/60)));

{$IFDEF OS2}
  If Not Local Then S1 := Long2Str (ApOS2. ComHandle);
  S := PlaceSubStr (S, '*H', S1);
{$ENDIF}

  fTranslateExecParams := S;
End;

Procedure InitShellUnit;
Begin
  DosShell := fDosShell;
  TranslateExecParams := fTranslateExecParams;
End;

End.
