home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 153.img / TELES.ZIP / DROPDOS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-26  |  3.9 KB  |  152 lines
  1. program DROPDOS;
  2.  
  3. {$V-} {$C-}
  4. {$I COMMON.PAS}
  5.  
  6. procedure return;
  7. var f:file;
  8. begin
  9.   assign(f,'bbs.com');
  10.   print('Returning to BBS...');
  11.   remove_port;
  12.   if hangup then term_ready(false);
  13.   execute(f);
  14. end;
  15.  
  16. Type
  17.   Str255=String[255];
  18.   Str66=String[66];
  19. Var
  20.   Command : str255;
  21.   SubRet : Integer;
  22.  
  23. Function SubProcess(CommandLine: Str255): Integer;
  24.  
  25.   Const
  26.     SSSave: Integer=0;
  27.     SPSave: Integer=0;
  28.  
  29.   Var
  30.     Regs: Record Case Integer Of
  31.             1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  32.             2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  33.           End;
  34.     FCB1,FCB2: Array [0..36] Of Byte;
  35.     PathName: Str66;
  36.     CommandTail: Str255;
  37.     ParmTable: Record
  38.                  EnvSeg: Integer;
  39.                  ComLin: ^Integer;
  40.                  FCB1Pr: ^Integer;
  41.                  FCB2Pr: ^Integer;
  42.                End;
  43.  
  44.   Begin
  45.     If Pos(' ',CommandLine)=0 Then
  46.      Begin
  47.       PathName:=CommandLine+#0;
  48.       CommandTail:=^M;
  49.      End
  50.     Else
  51.      Begin
  52.       PathName:=Copy(CommandLine,1,Pos(' ',CommandLine)-1)+#0;
  53.       CommandTail:=Copy(CommandLine,Pos(' ',CommandLine),255)+^M;
  54.      End;
  55.     CommandTail[0]:=Pred(CommandTail[0]);
  56.     With Regs Do
  57.      Begin
  58.       FillChar(FCB1,Sizeof(FCB1),0);
  59.       AX:=$2901;
  60.       DS:=Seg(CommandTail[1]);
  61.       SI:=Ofs(CommandTail[1]);
  62.       ES:=Seg(FCB1);
  63.       DI:=Ofs(FCB1);
  64.       MsDos(Regs); { Create FCB 1 }
  65.       FillChar(FCB2,Sizeof(FCB2),0);
  66.       AX:=$2901;
  67.       ES:=Seg(FCB2);
  68.       DI:=Ofs(FCB2);
  69.       MsDos(Regs); { Create FCB 2 }
  70.       ES:=CSeg;
  71.       BX:=SSeg-CSeg+MemW[CSeg:MemW[CSeg:$0101]+$112];
  72.       AH:=$4A;
  73.       MsDos(Regs); { Deallocate unused memory }
  74.       With ParmTable Do
  75.        Begin
  76.         EnvSeg:=MemW[CSeg:$002C];
  77.         ComLin:=Addr(CommandTail);
  78.         FCB1Pr:=Addr(FCB1);
  79.         FCB2Pr:=Addr(FCB2);
  80.        End;
  81.       InLine($8D/$96/ PathName+1 /  { <DX>:=Ofs(PathName[1]); }
  82.              $8D/$9E/ ParmTable /   { <BX>:=Ofs(ParmTable);   }
  83.              $B8/$00/$4B/           { <AX>:=$4B00;            }
  84.              $1E/$55/               { Save <DS>, <BP>         }
  85.              $16/$1F/               { <DS>:=Seg(PathName[1]); }
  86.              $16/$07/               { <ES>:=Seg(ParmTable);   }
  87.              $2E/$8C/$16/ SSSave /  { Save <SS> in SSSave     }
  88.              $2E/$89/$26/ SPSave /  { Save <SP> in SPSave     }
  89.              $FA/                   { Disable interrupts      }
  90.              $CD/$21/               { Call MS-DOS             }
  91.              $FA/                   { Disable interrupts      }
  92.              $2E/$8B/$26/ SPSave /  { Restore <SP>            }
  93.              $2E/$8E/$16/ SSSave /  { Restore <SS>            }
  94.              $FB/                   { Enable interrupts       }
  95.              $9C/$8F/$86/ Regs+18 / { Flags:=<CPU flags>      }
  96.              $89/$86/ Regs+0 /      { AX:=<AX>;               }
  97.              $5D/$1F);              { Restore <BP>,<DS>       }
  98.       If (Flags And 1)<>0 Then SubProcess:=AX
  99.       Else SubProcess:=0;
  100.      End;
  101.   End;
  102.  
  103. Function GetComSpec: Str66;
  104.   Type
  105.     Env=Array [0..32767] Of Char;
  106.   Var
  107.     EPtr: ^Env;
  108.     EStr: Str255;
  109.     Done: Boolean;
  110.     JI: Integer;
  111.  
  112.   Begin
  113.     EPtr:=Ptr(MemW[CSeg:$002C],0);
  114.     JI:=0;
  115.     Done:=False;
  116.     EStr:='';
  117.     Repeat
  118.       If EPtr^[JI]=#0 Then
  119.        Begin
  120.         If EPtr^[JI+1]=#0 Then Done:=True;
  121.         If Copy(EStr,1,8)='COMSPEC=' Then
  122.          Begin
  123.           GetComSpec:=Copy(EStr,9,100);
  124.           Done:=True;
  125.          End;
  126.         EStr:='';
  127.        End
  128.       Else EStr:=EStr+EPtr^[JI];
  129.       JI:=JI+1;
  130.     Until Done;
  131.   End;
  132.  
  133. Procedure DropDOS;
  134. var
  135.   t : real;
  136. begin
  137.   Command:=GetComSpec;
  138.   t:=timer;
  139.   writeln('Type "EXIT" to quit.');
  140.   SubRet:=Subprocess(Command);
  141.   chdir('C:\SOURCE');
  142.   clrscr;
  143.   chattime:=chattime+timer-t;
  144.   dump;
  145. end;
  146.  
  147. BEGIN
  148.   iport;
  149.   DROPDOS;
  150.   RETURN;
  151. END.
  152.