Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/SYSPC22.ZIP/SHELL.PAS

Pascal/Delphi Source File | 1989-02-19 | 5.0 KB | 181 lines

overlay procedure dos_shell (cmdlin:anystr);


type
_exec_str255 = string[255];
_exec_str66 = string[66];


Var
  _Exec_Regs: Record Case Integer Of
                1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
                2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
              End;
  { NOTE: the above variable is referenced in an Inline statement.  It MUST
    be a global variable (not a local variable or a typed constant)!! }






Function SubProcess(CommandLine: _Exec_Str255): Integer;
  Const
    SSSave: Integer=0;
    SPSave: Integer=0;

  Var
    FCB1,FCB2: Array [0..36] Of Byte; {*}
    PathName: _Exec_Str66;            {*}
    CommandTail: _Exec_Str255;
    ParmTable: Record                 {*}
                 EnvSeg: Integer;
                 ComLin: ^Integer;
                 FCB1Pr: ^Integer;
                 FCB2Pr: ^Integer;
               End;
    RegsFlags: Integer;               {*}
    {*: these variables are accessed in an Inline statement; their
        declarations must not be changed }

  Begin
    If Pos(' ',CommandLine)=0 Then
     Begin
      PathName:=CommandLine+#0;
      CommandTail:=^M;
     End
    Else
     Begin
      PathName:=Copy(CommandLine,1,Pred(Pos(' ',CommandLine)))+#0;
      CommandTail:=Copy(CommandLine,Pos(' ',CommandLine),255)+^M;
     End;
    CommandTail[0]:=Pred(CommandTail[0]);
    With _Exec_Regs Do
     Begin
      FillChar(FCB1,Sizeof(FCB1),0);
      AX:=$2901;
      DS:=Seg(CommandTail[1]);
      SI:=Ofs(CommandTail[1]);
      ES:=Seg(FCB1);
      DI:=Ofs(FCB1);
      MsDos(_Exec_Regs); { Create FCB 1 }
      FillChar(FCB2,Sizeof(FCB2),0);
      AX:=$2901;
      ES:=Seg(FCB2);
      DI:=Ofs(FCB2);
      MsDos(_Exec_Regs); { Create FCB 2 }
      With ParmTable Do
       Begin
        EnvSeg:=MemW[CSeg:$002C];
        ComLin:=Addr(CommandTail);
        FCB1Pr:=Addr(FCB1);
        FCB2Pr:=Addr(FCB2);
       End;
      InLine($8D/$96/ PathName /$42/  { <DX>:=Ofs(PathName[1]); }
             $8D/$9E/ ParmTable /     { <BX>:=Ofs(ParmTable);   }
             $B8/$00/$4B/             { <AX>:=$4B00;            }
             $1E/$55/                 { Save <DS>, <BP>         }
             $16/$1F/                 { <DS>:=Seg(PathName[1]); }
             $16/$07/                 { <ES>:=Seg(ParmTable);   }
             $2E/$8C/$16/ SSSave /    { Save <SS> in SSSave     }
             $2E/$89/$26/ SPSave /    { Save <SP> in SPSave     }
             $FA/                     { Disable interrupts      }
             $CD/$21/                 { Call MS-DOS             }
             $FA/                     { Disable interrupts      }
             $2E/$8B/$26/ SPSave /    { Restore <SP>            }
             $2E/$8E/$16/ SSSave /    { Restore <SS>            }
             $FB/                     { Enable interrupts       }
             $5D/$1F/                 { Restore <BP>,<DS>       }
             $9C/$8F/$86/ RegsFlags / { Flags:=<CPU flags>      }
             $A3/ _Exec_Regs );       { _Exec_Regs.AX:=<AX>;    }
      If (RegsFlags And 1)<>0 Then SubProcess:=AX
      Else SubProcess:=0;
     End;
  End;

Function GetEnvStr(SearchString: _Exec_Str255): _Exec_Str255;
  Type
    Env=Array [0..32767] Of Char;
  Var
    EPtr: ^Env;
    EStr: _Exec_Str255;
    Done: Boolean;
    I: Integer;

  Begin
    GetEnvStr:='';
    If SearchString<>'' Then
     Begin
      EPtr:=Ptr(MemW[CSeg:$002C],0);
      I:=0;
      SearchString:=SearchString+'=';
      Done:=False;
      EStr:='';
      Repeat
        If EPtr^[I]=#0 Then
         Begin
          If EPtr^[Succ(I)]=#0 Then
           Begin
            Done:=True;
            If SearchString='==' Then
             Begin
              EStr:='';
              I:=I+4;
              While EPtr^[I]<>#0 Do
               Begin
                EStr:=EStr+EPtr^[I];
                I:=Succ(I);
               End;
              GetEnvStr:=EStr;
             End;
           End;
          If Copy(EStr,1,Length(SearchString))=SearchString Then
           Begin
            GetEnvStr:=Copy(EStr,Succ(Length(SearchString)),255);
            Done:=True;
           End;
          EStr:='';
         End
        Else EStr:=EStr+EPtr^[I];
        I:=Succ(I);
      Until Done;
     End;
  End;

Function GetComSpec: _Exec_Str66;
  Begin
    GetComSpec:=GetEnvStr('COMSPEC');
  End;



Function SubProcessViaCOMMAND(CommandLine: _Exec_Str255): Integer;
  Begin
    SubProcessViaCOMMAND:=SubProcess(GetComSpec+' /C '+CommandLine);
  End;


Function Shell: Integer;
  Begin
    Shell:=SubProcess(GetComSpec);
  End;


Function SubProcessReturnCode: Integer;
  Begin
    _Exec_Regs.AH:=$4D;
    MsDos(_Exec_Regs);
    SubProcessReturnCode:=_Exec_Regs.AX;
  End;


var
  temp : integer;

begin
UNINIT;
IF CMDLiN='*' THEN WRITELN (USR,' Type EXIT to return back!');
  if cmdlin='*' then temp:=shell else temp := subprocessviacommand(cmdlin);
             setparam (usecom,baudrate,parity);
Shell_Return_Code:=subprocessreturnCode;
end;