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