Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/STDIN.ZIP/STDIN.PAS

Pascal/Delphi Source File | 1988-02-26 | 5.7 KB | 209 lines

unit StdIn;

{ A unit to accept standard input from a file via command line
  redirection and then revert to keyboard input automatically.

  Version 1.0 -   2/26/1988 - First general release

  Scott Bussinger
  Professional Practice Systems
  110 South 131st Street
  Tacoma, WA  98444
  [phone]
  Compuserve 72247,2671 }


interface

uses Dos;

procedure AssignStdIn(var F: text);
  { Assign the standard input channel to a file }

function KeyPressed: boolean;
  { Check the standard input device to see if a character is available }

function ReadKey: char;
  { Get a character from the standard input device }


implementation

const StandardErrorHandle = 2;

var ExitSave: pointer;
    ModeSave: boolean;

function SetDeviceMode(Handle: word;SetRawMode: boolean): boolean;
  { Return the current value of the device raw/cooked mode and set to new mode }
  var Regs: Registers;
  begin
  with Regs do
    begin
    AX := $4400;                                 { Get the current device status }
    BX := Handle;
    MsDos(Regs);
    SetDeviceMode := odd(DX shr 5);              { Test the current value of RAW bit }
    AX := $4401;                                 { Set the new device status }
    BX := Handle;
    DX := DX and $00DF;                          { Clear the RAW bit }
    if SetRawMode then
      inc(DX,32);                                { Turn the RAW bit on }
    MsDos(Regs)
    end
  end;

function TestHandle(Handle: word): boolean;
  { Check to see if the handle has data available, automatically
    switching handle to standard input device if file is exhausted }
  var Regs: Registers;

  function CheckEOF: boolean;
    { Check to see if handle is at EOF }
    begin
    with Regs do
      begin
      AX := $4406;                               { Check the file input status to see if we're at EOF }
      BX := Handle;
      MsDos(Regs);
      CheckEOF := AL = 0
      end
    end;

  begin
  with Regs do
    begin
    AX := $4400;                                 { Find out whether standard input has been redirected }
    BX := Handle;
    MsDos(Regs);
    if not odd(DX) then                          { It's not the standard input device }
      if CheckEOF then                           { Are we at EOF? }
        begin
        AH := $46;                               { Force the standard input file back to the standard error device }
        BX := StandardErrorHandle;
        CX := Handle;
        MsDos(Regs)
        end;
    TestHandle := not CheckEOF                   { Find out if there is data available }
    end
  end;

function ReadBytes(    Handle: word;
                   var NumBytes: word;
                   var Buffer): word;
  { Read some bytes from the handle into the buffer -- returns an error code }
  var Regs: Registers;
  begin
  with Regs do
    begin
    AH := $3F;                                   { Read a buffer-full from the handle }
    BX := Handle;
    CX := NumBytes;
    DS := seg(Buffer);
    DX := ofs(Buffer);
    MsDos(Regs);
    if odd(Flags)
     then
      ReadBytes := AX                            { Signal an error }
     else
      begin
      ReadBytes := 0;                            { Everything's fine }
      NumBytes := AX                             { Return number of bytes read }
      end
    end
  end;

function KeyPressed: boolean;
  { Check the standard input device to see if a character is available }
  begin
  KeyPressed := TestHandle(TextRec(Input).Handle)
  end;

function ReadKey: char;
  { Get a character from the standard input device }
  var Ch: char;
      NumBytes: word;
  begin
  repeat                                         { Wait for data }
  until TestHandle(TextRec(Input).Handle);
  NumBytes := 1;                                 { Only get one byte }
  NumBytes := ReadBytes(TextRec(Input).Handle,NumBytes,Ch);
  ReadKey := Ch
  end;

{$F+}
function StdInOpen(var F: TextRec): word;
{$F-}
  { Open a channel to the standard input device }
  begin
  with F do
    if Mode = fmInput
     then
      begin
      Handle := 0;                               { Simply assign the standard input handle }
      StdInOpen := 0
      end
     else
      StdInOpen := $0005                         { Error out with a 'File Access Denied' }
  end;

{$F+}
function StdInIn(var F: TextRec): word;
{$F-}
  { Do the actual input from the standard input device }
  var DontCare: boolean;
      Regs: Registers;
  begin
  with F do
    with Regs do
      begin
      DontCare := TestHandle(Handle);            { Possibly redirect input back to standard input }
      BufPos := 0;                               { Clear the input buffer }
      BufEnd := BufSize;                         { Default to full buffer }
      StdInIn := ReadBytes(Handle,BufEnd,BufPtr^){ Read in some data }
      end
  end;

{$F+}
function StdInIgnore(var F: TextRec): word;
{$F-}
  { This function does nothing }
  begin
  StdInIgnore := 0
  end;

procedure AssignStdIn(var F: text);
  { Assign the standard input channel to a file }
  begin
  with TextRec(F) do
    begin
    Mode := fmClosed;
    BufSize := sizeof(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @StdInOpen;
    InOutFunc := @StdInIn;
    FlushFunc := @StdInIgnore;
    CloseFunc := @StdInIgnore;
    Name[0] := #0
    end
  end;

{$F+}
procedure ExitHandler;
{$F-}
  { Restore the standard input device mode }
  var DontCare: boolean;
  begin
  ExitProc := ExitSave;
  DontCare := SetDeviceMode(StandardErrorHandle,ModeSave)
  end;

begin
ExitSave := ExitProc;
ExitProc := @ExitHandler;
ModeSave := SetDeviceMode(StandardErrorHandle,true);
close(Input);
AssignStdIn(Input);
reset(Input)
end.