home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / bbs / pibterm / pibt3sp1 / dosjump.pas < prev    next >
Pascal/Delphi Source File  |  1985-08-23  |  10KB  |  267 lines
  1. (*----------------------------------------------------------------------*)
  2. (*                      DosJump --- Jump to Dos                         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. OVERLAY PROCEDURE DosJump( Dos_String : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  DosJump;                                             *)
  10. (*                                                                      *)
  11. (*     Purpose:    Provides facility for jumping to DOS                 *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        DosJump( Dos_String : AnyStr );                               *)
  16. (*                                                                      *)
  17. (*           Dos_String --- DOS command to execute                      *)
  18. (*                                                                      *)
  19. (*     Calls:                                                           *)
  20. (*                                                                      *)
  21. (*        GetComSpec                                                    *)
  22. (*        SubProcess                                                    *)
  23. (*                                                                      *)
  24. (*----------------------------------------------------------------------*)
  25.  
  26. VAR
  27.    I: INTEGER;
  28.  
  29. { EXEC.PAS version 1.3
  30.  
  31.   This file contains 2 functions for Turbo Pascal that allow you to run other
  32.   programs from within a Turbo program.  The first function, SubProcess,
  33.   actually calls up a different program using MS-DOS call 4BH, EXEC.  The
  34.   second function, GetComSpec, returns the path name of the command
  35.   interpreter, which is necessary to do certain operations.  There is also a
  36.   main program that allows you to test the functions.
  37.  
  38.   Revision history
  39.   ----------------
  40.   Version 1.3 works with MS-DOS 2.0 and up, TURBO PASCAL version 1.0 and up.
  41.   Version 1.2 had a subtle but dangerous bug: I set a variable that was
  42.               addressed relative to BP, using a destroyed BP!
  43.   Version 1.1 didn't work with Turbo 2.0 because I used Turbo 3.0 features
  44.   Version 1.0 only worked with DOS 3.0 due to a subtle bug in DOS 2.x
  45.  
  46.     -  Bela Lubkin
  47.        Borland International Technical Support
  48.        CompuServe 71016,1573
  49. }
  50.  
  51. Type
  52.   Str66=String[66];
  53.   Str255=String[255];
  54.  
  55. Function SubProcess(CommandLine: Str255): Integer;
  56.   { Pass this function a string of the form
  57.       'D:\FULL\PATH\NAME\OF\FILE.TYP parameter1 parameter2 ...'
  58.  
  59.     For example,
  60.       'C:\SYSTEM\CHKDSK.COM'
  61.       'A:\WS.COM DOCUMENT.1'
  62.       'C:\DOS\LINK.EXE TEST;'
  63.       'C:\COMMAND.COM /C COPY *.* B:\BACKUP >FILESCOP.IED'
  64.  
  65.     The third example shows several things.  To do any of the following, you
  66.     must invoke the command processor and let it do the work: redirection;
  67.     piping; path searching; searching for the extension of a program (.COM,
  68.     .EXE, or .BAT); batch files; and internal DOS commands.  The name of the
  69.     command processor file is stored in the DOS environment.  The function
  70.     GetComSpec in this file returns the path name of the command processor.
  71.     Also note that you must use the /C parameter or COMMAND will not work
  72.     correctly.  You can also call COMMAND with no parameters.  This will allow
  73.     the user to use the DOS prompt to run anything (as long as there is enough
  74.     memory).  To get back to your program, he can type the command EXIT.
  75.  
  76.     Actual example:
  77.       I:=SubProcess(GetComSpec+' /C COPY *.* B:\BACKUP >FILESCOP.IED');
  78.  
  79.     The value returned is the result returned by DOS after the EXEC call.  The
  80.     most common values are:
  81.  
  82.        0: Success
  83.        1: Invalid function (should never happen with this routine)
  84.        2: File/path not found
  85.        8: Not enough memory to load program
  86.       10: Bad environment (greater than 32K)
  87.       11: Illegal .EXE file format
  88.  
  89.     If you get any other result, consult an MS-DOS Technical Reference manual.
  90.  
  91.     VERY IMPORTANT NOTE: you MUST use the Options menu of Turbo Pascal to
  92.     restrict the amount of free dynamic memory used by your program.  Only the
  93.     memory that is not used by the heap is available for use by other
  94.     programs. }
  95.  
  96.   Const
  97.     SSSave: Integer=0;
  98.     SPSave: Integer=0;
  99.  
  100.   Var
  101.     Regs: Record Case Integer Of
  102.             1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  103.             2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  104.           End;
  105.     FCB1,FCB2: Array [0..36] Of Byte;
  106.     PathName: Str66;
  107.     CommandTail: Str255;
  108.     ParmTable: Record
  109.                  EnvSeg: Integer;
  110.                  ComLin: ^Integer;
  111.                  FCB1Pr: ^Integer;
  112.                  FCB2Pr: ^Integer;
  113.                End;
  114.     I,RegsFlags: Integer;
  115.  
  116.   Begin
  117.                                    (* Change cursor to block *)
  118.     Regs.Ax := $0100;
  119.     Regs.Cx := $0107;
  120.  
  121.     INTR( $10, Regs );
  122.  
  123.     If Pos(' ',CommandLine)=0 Then
  124.      Begin
  125.       PathName:=CommandLine+#0;
  126.       CommandTail:=^M;
  127.      End
  128.     Else
  129.      Begin
  130.       PathName:=Copy(CommandLine,1,Pos(' ',CommandLine)-1)+#0;
  131.       CommandTail:=Copy(CommandLine,Pos(' ',CommandLine),255)+^M;
  132.      End;
  133.     CommandTail[0]:=Pred(CommandTail[0]);
  134.     With Regs Do
  135.      Begin
  136.       FillChar(FCB1,Sizeof(FCB1),0);
  137.       AX:=$2901;
  138.       DS:=Seg(CommandTail[1]);
  139.       SI:=Ofs(CommandTail[1]);
  140.       ES:=Seg(FCB1);
  141.       DI:=Ofs(FCB1);
  142.       MsDos(Regs); { Create FCB 1 }
  143.       FillChar(FCB2,Sizeof(FCB2),0);
  144.       AX:=$2901;
  145.       ES:=Seg(FCB2);
  146.       DI:=Ofs(FCB2);
  147.       MsDos(Regs); { Create FCB 2 }
  148.       ES:=CSeg;
  149.       BX:=SSeg-CSeg+MemW[CSeg:MemW[CSeg:$0101]+$112];
  150.       AH:=$4A;
  151.       MsDos(Regs); { Deallocate unused memory }
  152.       With ParmTable Do
  153.        Begin
  154.         EnvSeg:=MemW[CSeg:$002C];
  155.         ComLin:=Addr(CommandTail);
  156.         FCB1Pr:=Addr(FCB1);
  157.         FCB2Pr:=Addr(FCB2);
  158.        End;
  159.       InLine($8D/$96/ PathName /$42/  { <DX>:=Ofs(PathName[1]); }
  160.              $8D/$9E/ ParmTable /     { <BX>:=Ofs(ParmTable);   }
  161.              $B8/$00/$4B/             { <AX>:=$4B00;            }
  162.              $1E/$55/                 { Save <DS>, <BP>         }
  163.              $16/$1F/                 { <DS>:=Seg(PathName[1]); }
  164.              $16/$07/                 { <ES>:=Seg(ParmTable);   }
  165.              $2E/$8C/$16/ SSSave /    { Save <SS> in SSSave     }
  166.              $2E/$89/$26/ SPSave /    { Save <SP> in SPSave     }
  167.              $FA/                     { Disable interrupts      }
  168.              $CD/$21/                 { Call MS-DOS             }
  169.              $FA/                     { Disable interrupts      }
  170.              $2E/$8B/$26/ SPSave /    { Restore <SP>            }
  171.              $2E/$8E/$16/ SSSave /    { Restore <SS>            }
  172.              $FB/                     { Enable interrupts       }
  173.              $5D/$1F/                 { Restore <BP>,<DS>       }
  174.              $9C/$8F/$86/ RegsFlags / { Flags:=<CPU flags>      }
  175.              $89/$86/ Regs );         { Regs.AX:=<AX>;          }
  176.       { The messing around with SS and SP is necessary because under DOS 2.x,
  177.         after returning from an EXEC call, ALL registers are destroyed except
  178.         CS and IP!  I wish I'd known that before I released this package the
  179.         first time... }
  180.       If (RegsFlags And 1)<>0 Then SubProcess:=AX
  181.       Else SubProcess:=0;
  182.      End;
  183.                                    (* Change cursor back to underline *)
  184.     Regs.Ax := $0100;
  185.     Regs.Cx := $0607;
  186.  
  187.     INTR( $10, Regs );
  188.  
  189.   End;
  190.  
  191. Function GetComSpec: Str66;
  192.   Type
  193.     Env=Array [0..32767] Of Char;
  194.   Var
  195.     EPtr: ^Env;
  196.     EStr: Str255;
  197.     Done: Boolean;
  198.     I: Integer;
  199.  
  200.   Begin
  201.     EPtr:=Ptr(MemW[CSeg:$002C],0);
  202.     I:=0;
  203.     Done:=False;
  204.     EStr:='';
  205.     Repeat
  206.       If EPtr^[I]=#0 Then
  207.        Begin
  208.         If EPtr^[I+1]=#0 Then Done:=True;
  209.         If Copy(EStr,1,8)='COMSPEC=' Then
  210.          Begin
  211.           GetComSpec:=Copy(EStr,9,100);
  212.           Done:=True;
  213.          End;
  214.         EStr:='';
  215.        End
  216.       Else EStr:=EStr+EPtr^[I];
  217.       I:=I+1;
  218.     Until Done;
  219.   End;
  220.  
  221. BEGIN (* DosJump *)
  222.  
  223.    WRITELN;
  224.    WRITELN('Jump to DOS:  Enter EXIT to return to PibTerm');
  225.  
  226.                                    (* Close capture file *)
  227.    IF Capture_On THEN
  228.          (*$I-*)
  229.       CLOSE( Capture_File );
  230.          (*$I+*)
  231.  
  232.    I := Int24Result;
  233.                                    (* Remove Int 24 error handler *)
  234.    Int24OFF;
  235.  
  236.    IF LENGTH( Dos_String ) > 0 THEN
  237.       I := SubProcess( GetComSpec + ' /C ' + Dos_String )
  238.    ELSE
  239.       I := SubProcess( GetComSpec );
  240.  
  241.                                    (* Restore Int24 Error handler *)
  242.    Int24ON;
  243.  
  244.    WRITELN('Back to PibTerm, DOS return code is ',I);
  245.  
  246.                                    (* Reopen capture file for append *)
  247.    IF Capture_On THEN
  248.       BEGIN
  249.  
  250.          ASSIGN( Capture_File , Capture_File_Name );
  251.             (*$I-*)
  252.          APPEND( Capture_File );
  253.             (*$I+*)
  254.  
  255.          IF Int24Result <> 0 THEN
  256.             BEGIN
  257.                WRITELN('Could not re-open capture file ',
  258.                         Capture_File_Name,' for append,');
  259.                WRITELN('Capture option TURNED OFF.');
  260.                Capture_On := FALSE;
  261.                DELAY( Two_Second_Delay );
  262.             END;
  263.  
  264.       END;
  265.  
  266. END   (* DosJump *);
  267. ə