home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / dos.swg / 0069_Redirection.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  4.2 KB  |  149 lines
  1.  
  2. { I found an example of DOS redirection using TP.  I think it came from either
  3.   Dr. Dobb's or PC Magazine in 1992.  I used this in my BinarY TExt (BYTE)
  4.   file tool which performs file splits, merges, encryption/decryption, script
  5.   execution, and complete backwards and forwards byte resolution manipulation.
  6. }
  7. UNIT Echo;
  8.  
  9. INTERFACE
  10.  
  11. USES DOS;
  12.  
  13.   FUNCTION InputRedirected : Boolean;
  14.   FUNCTION OutputRedirected : Boolean;
  15.   FUNCTION OutputNul : Boolean;
  16.   FUNCTION EchoIsOn : Boolean;
  17.   PROCEDURE EchoOn;
  18.   PROCEDURE EchoOff;
  19.  
  20. IMPLEMENTATION
  21.  
  22.   FUNCTION InputRedirected : Boolean;
  23.   VAR Regs : Registers; Handle : Word ABSOLUTE Input;
  24.   BEGIN
  25.     WITH Regs DO
  26.       BEGIN
  27.         Ax := $4400;
  28.         Bx := Handle;
  29.         MsDos(Regs);
  30.         IF Dl AND $81 = $81 THEN InputRedirected := False
  31.         ELSE InputRedirected := True;
  32.       END;                        {With Regs}
  33.   END;                            {Function InputRedirected}
  34.  
  35.  
  36.   FUNCTION OutputRedirected : Boolean;
  37.   VAR Regs : Registers; Handle : Word ABSOLUTE Output;
  38.   BEGIN
  39.     WITH Regs DO
  40.       BEGIN
  41.         Ax := $4400;
  42.         Bx := Handle;
  43.         MsDos(Regs);
  44.         IF Dl AND $82 = $82 THEN OutputRedirected := False
  45.         ELSE OutputRedirected := True;
  46.       END;                        {With Regs}
  47.   END;                            {Function OutputRedirected}
  48.  
  49.  
  50.   FUNCTION OutputNul : Boolean;
  51.   VAR Regs : Registers; Handle : Word ABSOLUTE Output;
  52.   BEGIN
  53.     WITH Regs DO
  54.       BEGIN
  55.         Ax := $4400;
  56.         Bx := Handle;
  57.         MsDos(Regs);
  58.         IF Dl AND $84 <> $84 THEN OutputNul := False
  59.         ELSE OutputNul := True;
  60.       END;                        {With Regs}
  61.   END;                            {Function OutputNul}
  62.  
  63.  
  64.   FUNCTION Write40h(DataBuffer : Pointer; Count, Handle : Word) : Word;
  65.   VAR Regs : Registers;
  66.   TYPE DWord = RECORD O, S : Word; END;
  67.   BEGIN
  68.     WITH Regs DO
  69.       BEGIN
  70.         Ds := DWord(DataBuffer).S;
  71.         Dx := DWord(DataBuffer).O;
  72.         Bx := Handle;
  73.         Cx := Count;
  74.         Ah := $40;
  75.         MsDos(Regs);
  76.         IF Flags AND FCarry <> 0
  77.         THEN Write40h := 103      {- "file not open" -}
  78.         ELSE IF Ax < Cx
  79.         THEN Write40h := 101      {- "disk write error" -}
  80.         ELSE Write40h := 0;
  81.       END;                        {With Regs do}
  82.   END;                            {Function Write40h}
  83.  
  84.  
  85. {$F+} FUNCTION EchoOutput(VAR F : TextRec) : Integer; {$F-}
  86. {- Replacement for Output text file FlushFunc and InOutFunc -}
  87.   BEGIN
  88.     WITH F DO
  89.       BEGIN
  90.         EchoOutput := Write40h(BufPtr, BufPos, 2);
  91.         EchoOutput := Write40h(BufPtr, BufPos, Handle);
  92.         BufPos := 0;
  93.       END;                        {With F do}
  94.   END;                            {Function EchoOutput}
  95.  
  96.  
  97. CONST EchoStatus : Boolean = False; {- PRIVATE to unit Echo -}
  98.  
  99.   PROCEDURE EchoOn;
  100.   BEGIN
  101.     IF OutputRedirected THEN
  102.       BEGIN
  103.         Flush(Output);
  104.         TextRec(Output).InOutFunc := @EchoOutput;
  105.         TextRec(Output).FlushFunc := @EchoOutput;
  106.         EchoStatus := True;
  107.       END;                        {If OutputRedirected}
  108.   END;                            {Procedure EchoOn}
  109.  
  110.   PROCEDURE EchoOff;
  111.   BEGIN
  112.     IF OutputRedirected THEN
  113.       BEGIN
  114.         Rewrite(Output);
  115.         EchoStatus := False;
  116.       END;                        {If OutputRedirected THEN}
  117.   END;                            {Procedure EchoOff}
  118.  
  119.   FUNCTION EchoIsOn : Boolean;
  120.   BEGIN
  121.     EchoIsOn := EchoStatus;
  122.   END;                            {Function EchoIsOn}
  123.  
  124.  
  125. BEGIN                             {- Unit initialization -}
  126.   EchoOn;                         {- Echo all redirected output -}
  127. END.
  128.  
  129. {-------------------------------------------------------------------}
  130. PROGRAM EchoDemo;
  131. USES Echo;
  132. BEGIN
  133.   IF InputRedirected THEN WriteLn('Input is being redirected');
  134.   IF OutputNul THEN
  135.     BEGIN
  136.       WriteLn('Output is being sent to the Nul device');
  137.       EchoOff;
  138.     END;
  139.   IF OutputRedirected THEN WriteLn('Output is being redirected');
  140.  
  141.   WriteLn('--------1--------');
  142.   EchoOff;
  143.   WriteLn('--------2--------');
  144.   IF NOT OutputNul THEN EchoOn;
  145.   WriteLn('--------3--------');
  146.   EchoOff;
  147.   WriteLn('--------4--------');
  148. END.
  149.