home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / exec.swg / 0001_EXECHILD.PAS.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  4.4 KB  |  187 lines
  1. (* This unit lets you execute any child program and redirect the
  2.    child program output to NUL / PRN / CON or file.
  3.    It's very simple to use (look at the EXAMPLE.PAS).
  4.    This source is completlly freeware but make sure to remove
  5.    this remark if any changes are made I don't want anyone to
  6.    spread his bugs with my source.
  7.    Of course any suggestions are welcome as well as questions
  8.    about the source.
  9.  
  10.    Written by Schwartz Gabriel.   20/03/1993.
  11.    Anyone who has any question can leave me a message at 
  12.    CompuServe to EliaShim address 100320,36
  13. *)
  14.  
  15. {$A+,B-,D-,E-,F+,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}
  16.  
  17. Unit Redir;
  18.  
  19. Interface
  20.  
  21. Var
  22.   IOStatus      : Integer;
  23.   RedirError    : Integer;
  24.   ExecuteResult : Word;
  25.  
  26. {------------------------------------------------------------------------------}
  27. procedure Execute (ProgName, ComLine, Redir: String);
  28. {------------------------------------------------------------------------------}
  29.  
  30. Implementation
  31.  
  32. Uses DOS;
  33.  
  34. Type
  35.   PMCB = ^TMCB;
  36.   TMCB = record
  37.            Typ   : Char;
  38.            Owner : Word;
  39.            Size  : Word;
  40.          end;
  41.  
  42.   PtrRec = record
  43.              Ofs, Seg : Word;
  44.            end;
  45.  
  46.   THeader = record
  47.               Signature : Word;
  48.               PartPag   : Word;
  49.               PageCnt   : Word;
  50.               ReloCnt   : Word;
  51.               HdrSize   : Word;
  52.               MinMem    : Word;
  53.               MaxMem    : Word;
  54.               ReloSS    : Word;
  55.               ExeSP     : Word;
  56.               ChkSum    : Word;
  57.               ExeIP     : Word;
  58.               ReloCS    : Word;
  59.               TablOff   : Word;
  60.               OverNo    : Word;
  61.             end;
  62.  
  63. Var
  64.   PrefSeg      : Word;
  65.   MinBlockSize : Word;
  66.   MCB          : PMCB;
  67.   FName        : PathStr;
  68.   F            : File;
  69.   MyBlockSize  : Word;
  70.   Header       : THeader;
  71.  
  72. {------------------------------------------------------------------------------}
  73.  
  74. procedure Execute (ProgName, ComLine, Redir: String);
  75.  
  76. type
  77.   PHandles = ^THandles;
  78.   THandles = Array [Byte] of Byte;
  79.  
  80.   PWord = ^Word;
  81.  
  82. var
  83.   RedirChanged : Boolean;
  84.   Handles      : PHandles;
  85.   OldHandle    : Byte;
  86.  
  87.   {............................................................................}
  88.  
  89.   function ChangeRedir : Boolean;
  90.  
  91.   begin
  92.     ChangeRedir:=False;
  93.     If Redir = '' then Exit;
  94.     Assign (F, Redir);
  95.     Rewrite (F);
  96.     RedirError:=IOResult;
  97.     If IOStatus <> 0 then Exit;
  98.     Handles:=Ptr (PrefixSeg, PWord (Ptr (PrefixSeg, $34))^);
  99.     OldHandle:=Handles^[1];
  100.     Handles^[1]:=Handles^[FileRec (F).Handle];
  101.     ChangeRedir:=True;
  102.   end;
  103.  
  104.   {............................................................................}
  105.  
  106.   procedure CompactHeap;
  107.  
  108.   var
  109.     Regs : Registers;
  110.  
  111.   begin
  112.     Regs.AH:=$4A;
  113.     Regs.ES:=PrefSeg;
  114.     Regs.BX:=MinBlockSize + (PtrRec (HeapPtr).Seg - PtrRec (HeapOrg).Seg);
  115.     MsDos (Regs);
  116.   end;
  117.  
  118.   {............................................................................}
  119.  
  120.   procedure DosExecute;
  121.  
  122.   Begin
  123.     SwapVectors;
  124.     Exec (ProgName, ComLine);
  125.     IOStatus:=DosError;
  126.     ExecuteResult:=DosExitCode;
  127.     SwapVectors;
  128.   End;
  129.  
  130.   {............................................................................}
  131.  
  132.   procedure ExpandHeap;
  133.  
  134.   var
  135.     Regs : Registers;
  136.  
  137.   begin
  138.     Regs.AH:=$4A;
  139.     Regs.ES:=PrefSeg;
  140.     Regs.BX:=MyBlockSize;
  141.     MsDos (Regs);
  142.   end;
  143.  
  144.   {............................................................................}
  145.  
  146.   procedure RestoreRedir;
  147.  
  148.   begin
  149.     If not RedirChanged then Exit;
  150.     Handles^[1]:=OldHandle;
  151.     Close (F);
  152.   end;
  153.  
  154.   {............................................................................}
  155.  
  156. Begin
  157.   RedirError:=0;
  158.   RedirChanged:=ChangeRedir;
  159.   CompactHeap;
  160.   DosExecute;
  161.   Expandheap;
  162.   RestoreRedir;
  163. End;
  164.  
  165. {------------------------------------------------------------------------------}
  166.  
  167. Begin
  168.   SetCBreak (False);
  169.   FName:=ParamStr (0);
  170.   Assign (F, FName);
  171.   Reset (F, 1);
  172.   IOStatus:=IOResult;
  173.   If IOStatus = 0 then
  174.     begin
  175.       BlockRead (F, Header, SizeOf (Header));
  176.       IOStatus:=IOResult;
  177.       If IOStatus = 0 then MinBlockSize:=Header.PageCnt * 32 + Header.MinMem + 1
  178.       Else MinBlockSize:=$8000;
  179.       Close (F);
  180.     end
  181.   Else MinBlockSize:=$8000;
  182.   PtrRec (MCB).Seg:=PrefixSeg - 1;
  183.   PtrRec (MCB).Ofs:=$0000;
  184.   MyBlockSize:=MCB^.Size;
  185.   PrefSeg:=PrefixSeg;
  186. End.
  187.