Contributor: SWAG SUPPORT TEAM
(* 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:=4ドルA;
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:=4ドルA;
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.