Contributor: JOHN HOWARD
{ I found an example of DOS redirection using TP. I think it came from either
Dr. Dobb's or PC Magazine in 1992. I used this in my BinarY TExt (BYTE)
file tool which performs file splits, merges, encryption/decryption, script
execution, and complete backwards and forwards byte resolution manipulation.
}
UNIT Echo;
INTERFACE
USES DOS;
FUNCTION InputRedirected : Boolean;
FUNCTION OutputRedirected : Boolean;
FUNCTION OutputNul : Boolean;
FUNCTION EchoIsOn : Boolean;
PROCEDURE EchoOn;
PROCEDURE EchoOff;
IMPLEMENTATION
FUNCTION InputRedirected : Boolean;
VAR Regs : Registers; Handle : Word ABSOLUTE Input;
BEGIN
WITH Regs DO
BEGIN
Ax := 4400ドル;
Bx := Handle;
MsDos(Regs);
IF Dl AND 81ドル = 81ドル THEN InputRedirected := False
ELSE InputRedirected := True;
END; {With Regs}
END; {Function InputRedirected}
FUNCTION OutputRedirected : Boolean;
VAR Regs : Registers; Handle : Word ABSOLUTE Output;
BEGIN
WITH Regs DO
BEGIN
Ax := 4400ドル;
Bx := Handle;
MsDos(Regs);
IF Dl AND 82ドル = 82ドル THEN OutputRedirected := False
ELSE OutputRedirected := True;
END; {With Regs}
END; {Function OutputRedirected}
FUNCTION OutputNul : Boolean;
VAR Regs : Registers; Handle : Word ABSOLUTE Output;
BEGIN
WITH Regs DO
BEGIN
Ax := 4400ドル;
Bx := Handle;
MsDos(Regs);
IF Dl AND 84ドル 84ドル THEN OutputNul := False
ELSE OutputNul := True;
END; {With Regs}
END; {Function OutputNul}
FUNCTION Write40h(DataBuffer : Pointer; Count, Handle : Word) : Word;
VAR Regs : Registers;
TYPE DWord = RECORD O, S : Word; END;
BEGIN
WITH Regs DO
BEGIN
Ds := DWord(DataBuffer).S;
Dx := DWord(DataBuffer).O;
Bx := Handle;
Cx := Count;
Ah := 40ドル;
MsDos(Regs);
IF Flags AND FCarry 0
THEN Write40h := 103 {- "file not open" -}
ELSE IF Ax < Cx
THEN Write40h := 101 {- "disk write error" -}
ELSE Write40h := 0;
END; {With Regs do}
END; {Function Write40h}
{$F+} FUNCTION EchoOutput(VAR F : TextRec) : Integer; {$F-}
{- Replacement for Output text file FlushFunc and InOutFunc -}
BEGIN
WITH F DO
BEGIN
EchoOutput := Write40h(BufPtr, BufPos, 2);
EchoOutput := Write40h(BufPtr, BufPos, Handle);
BufPos := 0;
END; {With F do}
END; {Function EchoOutput}
CONST EchoStatus : Boolean = False; {- PRIVATE to unit Echo -}
PROCEDURE EchoOn;
BEGIN
IF OutputRedirected THEN
BEGIN
Flush(Output);
TextRec(Output).InOutFunc := @EchoOutput;
TextRec(Output).FlushFunc := @EchoOutput;
EchoStatus := True;
END; {If OutputRedirected}
END; {Procedure EchoOn}
PROCEDURE EchoOff;
BEGIN
IF OutputRedirected THEN
BEGIN
Rewrite(Output);
EchoStatus := False;
END; {If OutputRedirected THEN}
END; {Procedure EchoOff}
FUNCTION EchoIsOn : Boolean;
BEGIN
EchoIsOn := EchoStatus;
END; {Function EchoIsOn}
BEGIN {- Unit initialization -}
EchoOn; {- Echo all redirected output -}
END.
{-------------------------------------------------------------------}
PROGRAM EchoDemo;
USES Echo;
BEGIN
IF InputRedirected THEN WriteLn('Input is being redirected');
IF OutputNul THEN
BEGIN
WriteLn('Output is being sent to the Nul device');
EchoOff;
END;
IF OutputRedirected THEN WriteLn('Output is being redirected');
WriteLn('--------1--------');
EchoOff;
WriteLn('--------2--------');
IF NOT OutputNul THEN EchoOn;
WriteLn('--------3--------');
EchoOff;
WriteLn('--------4--------');
END.