[Back to EXEC SWAG index] [Back to Main SWAG index] [Original]

    (* This unit lets you execute any child program and redirect the
       child program output to NUL / PRN / CON or file.
       It's very simple to use (look at the EXAMPLE.PAS).
       This source is completlly freeware but make sure to remove
       this remark if any changes are made I don't want anyone to
       spread his bugs with my source.
       Of course any suggestions are welcome as well as questions
       about the source.

       Written by Schwartz Gabriel.   20/03/1993.
       Anyone who has any question can leave me a message at
       CompuServe to EliaShim address 100320,36
    *)

    {$A+,B-,D-,E-,F+,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}

    Unit Redir;

    Interface

    Var
      IOStatus      : Integer;
      RedirError    : Integer;
      ExecuteResult : Word;

    {------------------------------------------------------------------------------}
    procedure Execute (ProgName, ComLine, Redir: String);
    {------------------------------------------------------------------------------}

    Implementation

    Uses DOS;

    Type
      PMCB = ^TMCB;
      TMCB = record
               Typ   : Char;
               Owner : Word;
               Size  : Word;
             end;

      PtrRec = record
                 Ofs, Seg : Word;
               end;

      THeader = record
                  Signature : Word;
                  PartPag   : Word;
                  PageCnt   : Word;
                  ReloCnt   : Word;
                  HdrSize   : Word;
                  MinMem    : Word;
                  MaxMem    : Word;
                  ReloSS    : Word;
                  ExeSP     : Word;
                  ChkSum    : Word;
                  ExeIP     : Word;
                  ReloCS    : Word;
                  TablOff   : Word;
                  OverNo    : Word;
                end;

    Var
      PrefSeg      : Word;
      MinBlockSize : Word;
      MCB          : PMCB;
      FName        : PathStr;
      F            : File;
      MyBlockSize  : Word;
      Header       : THeader;

    {------------------------------------------------------------------------------}

    procedure Execute (ProgName, ComLine, Redir: String);

    type
      PHandles = ^THandles;
      THandles = Array [Byte] of Byte;

      PWord = ^Word;

    var
      RedirChanged : Boolean;
      Handles      : PHandles;
      OldHandle    : Byte;

      {............................................................................}

      function ChangeRedir : Boolean;

      begin
        ChangeRedir:=False;
        If Redir = '' then Exit;
        Assign (F, Redir);
        Rewrite (F);
        RedirError:=IOResult;
        If IOStatus <> 0 then Exit;
        Handles:=Ptr (PrefixSeg, PWord (Ptr (PrefixSeg, $34))^);
        OldHandle:=Handles^[1];
        Handles^[1]:=Handles^[FileRec (F).Handle];
        ChangeRedir:=True;
      end;

      {............................................................................}

      procedure CompactHeap;

      var
        Regs : Registers;

      begin
        Regs.AH:=$4A;
        Regs.ES:=PrefSeg;
        Regs.BX:=MinBlockSize + (PtrRec (HeapPtr).Seg - PtrRec (HeapOrg).Seg);
        MsDos (Regs);
      end;

      {............................................................................}

      procedure DosExecute;

      Begin
        SwapVectors;
        Exec (ProgName, ComLine);
        IOStatus:=DosError;
        ExecuteResult:=DosExitCode;
        SwapVectors;
      End;

      {............................................................................}

      procedure ExpandHeap;

      var
        Regs : Registers;

      begin
        Regs.AH:=$4A;
        Regs.ES:=PrefSeg;
        Regs.BX:=MyBlockSize;
        MsDos (Regs);
      end;

      {............................................................................}

      procedure RestoreRedir;

      begin
        If not RedirChanged then Exit;
        Handles^[1]:=OldHandle;
        Close (F);
      end;

      {............................................................................}

    Begin
      RedirError:=0;
      RedirChanged:=ChangeRedir;
      CompactHeap;
      DosExecute;
      Expandheap;
      RestoreRedir;
    End;

    {------------------------------------------------------------------------------}

    Begin
      SetCBreak (False);
      FName:=ParamStr (0);
      Assign (F, FName);
      Reset (F, 1);
      IOStatus:=IOResult;
      If IOStatus = 0 then
        begin
          BlockRead (F, Header, SizeOf (Header));
          IOStatus:=IOResult;
          If IOStatus = 0 then MinBlockSize:=Header.PageCnt * 32 + Header.MinMem + 1
          Else MinBlockSize:=$8000;
          Close (F);
        end
      Else MinBlockSize:=$8000;
      PtrRec (MCB).Seg:=PrefixSeg - 1;
      PtrRec (MCB).Ofs:=$0000;
      MyBlockSize:=MCB^.Size;
      PrefSeg:=PrefixSeg;
    End.

[Back to EXEC SWAG index] [Back to Main SWAG index] [Original]