{      Type this to a file called PRINTIT4.PAS                } 
 

{ Written by the Lizard King, Clifford Roche email fluffy200@hotmail.com} 

{$R-} 
 

Unit Print_it_4; 

Interface 

Uses DOS,CRT; 
Var 
  LST : Text;                      { Public LST file variable } 
Function VerifyPortL (LPT: WORD): Byte; 

Procedure SetPrinter( Port:Byte ); 
{      SetPrinter sets the printer number to Port where Port  } 
{ is 'n' in 'LPTn'.  ie.  To write to LPT1: SetPrinter(1),    } 
{ for LPT2: SetPrinter(2).  SetPrinter changes the Port that  } 
{ subsequent Write operations will write to.  This lets you   } 
{ change the printer that you are printing to on the fly.     } 

Implementation 

Function PrinterCheck( PortNum, Error:Byte; Var Pos:Word):Boolean; 
Var 
  Response : Char; 
  Regs     : Registers; 
  OldTextAttr : Byte; 
  NewPos : Word; 
Begin 
  Response := 'R';                { Assume Retry              } 
  NewPos := Pos;                  { Assume no Error           } 
  While ((Error and $29) <> 0) and (Response = 'R') do 
  Begin 
    NewPos := Pos - 1;            { Decrement to reprint char } 
    OldTextAttr := TextAttr;      { Save Old Attribute        } 
    TextAttr := TextAttr or $80;  { Turn on Blink Bit         } 
    Write( #13'Printer Not Ready!   ' );     { Write the user } 
    Write( 'A) Abort, R) Retry, I) Ignore '#13 ); { a message } 
    TextAttr := OldTextAttr;      { Restore Old Attribute     } 
    Response := Upcase( Readkey );{ Read Char and upcase it   } 
    ClrEol;                       { Clear Line                } 
    If Response = 'A' then        { If Abort then exit        } 
      halt( 160 );                { Note: Uses Exit Proc.     } 
    If Response = 'R' then 
    Begin 
      Regs.AH := 2;                 { Code for Check Status   } 
      Regs.DX := PortNum;           { Printer port number -1  } 
      Intr($17,Regs);               { Call printer service    } 
      Error := Regs.AH;             { save Printer Error Code } 
                                    { 00000001 = Time Out     } 
                                    { 00000010 = Unused       } 
                                    { 00000100 = Unused       } 
                                    { 00001000 = I/O Error    } 
                                    { 00010000 = Selected     } 
                                    { 00100000 = Out of Paper } 
                                    { 01000000 = Acknowledge  } 
                                    { 10000000 = Not busy     } 
    End; 
  End; 
  PrinterCheck := Response = 'R'; 
  Pos := NewPos; 
End; 
 

Function PrinterReady(PortNum:Byte):Boolean; 
Var 
  Ready    : Boolean; 
  Dummy    : word; 
  Regs     : Registers; 
Begin 
    Regs.AH := 2;                   { Code for Check Status   } 
    Regs.DX := PortNum;             { Printer port number -1  } 
    Intr($17,Regs);                 { Call printer service    } 
    PrinterReady := PrinterCheck( PortNum, Regs.AH, Dummy ) 
End; 
 

{      The following routines MUST be FAR calls because they  } 
{ are called by the Read and Write routines.  (They are not   } 
{ Public (in the implementation section) because they should  } 
{ only be accessed by the Read and Write routines.)           } 
 

{$F+} 
 

{      LSTNoFunction performs a NUL operation for a Reset or  } 
{ Rewrite on LST (just in case).                              } 
 

Function LSTNoFunction( Var F: TextRec ): integer; 
Begin 
  LSTNoFunction := 0;                    { No error           } 
end; 
 

{      LSTOutputToPrinter sends the output to the Printer     } 
{ port number stored in the first byte or the UserData area   } 
{ of the Text Record.                                         } 
 

Function LSTOutputToPrinter( Var F: TextRec ): integer; 
var 
  Regs: Registers; 
  P : Word; 
begin 
  With F do 
  Begin 
    P := 0; 
    If PrinterReady( F.UserData[1] ) Then 
    While (P < BufPos) do 
    Begin 
      Regs.AL := Ord(BufPtr^[P]); 
      Regs.AH := 0; 
      Regs.DX := UserData[1]; 
      Intr($17,Regs); 
      Inc(P); 
      If Not PrinterCheck( F.UserData[1], Regs.AH, P ) then 
        P := BufPos; 
    End; 
    BufPos := 0; 
  End; 
  LSTOutputToPrinter := 0              { No error           } 
End; 
 

{$F-} 
 

{      AssignLST both sets up the LST text file record as     } 
{ would ASSIGN, and initializes it as would a RESET.  It also } 
{ stores the Port number in the first Byte of the UserData    } 
{ area.                                                       } 
 

Procedure AssignLST( Port:Byte ); 
Begin 
  With TextRec(LST) do 
    begin 
      Handle      := $FFF0; 
      Mode        := fmOutput; 
      BufSize     := SizeOf(Buffer); 
      BufPtr      := @Buffer; 
      BufPos      := 0; 
      OpenFunc    := @LSTNoFunction; 
      InOutFunc   := @LSTOutputToPrinter; 
      FlushFunc   := @LSTOutputToPrinter; 
      CloseFunc   := @LSTOutputToPrinter; 
      UserData[1] := Port - 1;  { We subtract one because } 
  end;                          { DOS Counts from zero.   } 
end; 
 

function VerifyPortL (LPT: Word): Byte; 
{Pass 1 in LPT to see if the printer is hooked up.} 
begin 
  asm 
    mov ah,2 
    mov dx,LPT 
    dec dx 
    int $17 
    mov @Result,ah 
  end; 
end;  {GetPrinterStatus} 
 

Procedure SetPrinter( Port:Byte ); { Documented above     } 
Begin 
  With TextRec(LST) do 
    UserData[1] := Port - 1;{ We subtract one because DOS } 
End;                        { Counts from zero.           } 
 

Begin  { Initialization } 
  AssignLST( 1 );           { Call assignLST so it works  } 
end.                        { like Turbo's Printer unit   } 

On Sat, 11 Jul 1998 09:26:58 +0100, Jim Barr
<jimbarr@wandana.demon.co.uk> wrote:

>>:>And do not forget that if you are reading from a file and printing to
>>:>the printer, you MUST close the file to ensure that ALL the file goes to
>>:>the printer
>>:

Clearly, what you said, cannot be true.

You are reading data from a file (read(f,blah)) and sending them
immediately to the printer "file" (write(lst,blah).

If you _did_ read data from the file the data are in your variable
blah and if you sent 'blah' then to the printer they are going to be
printed. The fact of closing the file f _after_ already having got the
data into your program and sent them to the printer cannot have any
inpact on the past.

Things are dramatically different if you _write_ something _to_ a TEXT
file on disk, though. You are obviously mixing up "reading from a disk
file" and "writing to a disk file".
 

var f:TEXT;
begin
  assign(f,'blah');rewrite(f);
  writeln(f,'hello');
end.

After executing this program you will have and empty file 'bla' (0
bytes) on disk. The reason is that a 'write' doesn't go directly do
disk in the moment it is executed. It will go to a buffer (of size 128
bytes by default) which is part of the variable f. If the file is a
_disk_ file, data from the buffer will be written do disk (more
precisely: TP will hand the data to a DOS-function which will write
the data now or later to disk) only in one of the 3 cases a) b) c).

a) the buffer is full
b) flush(f)
c) close(f)

In the above case the buffer is not full, i.e. the data in the buffer
will never go to DOS because there was no flush(f) and no close(f).

The action of flush(f) is : commit the buffer data to DOS.
The file will stay open. close(f) will implictly call flush(f).

There are very few situations why you would ever use flush(f) in a TP
program. One of them is:

You are keeping a log file which you rewrite/append at program startup
and which you intend to close at program exit. If your program will
crash with a run time error or if the user cancels the program with ^C
or ^Break (in case the program does not inbit this by
CRT.checkbreak:=false _and_ SetCbreak(false)) the log file will be
closed by DOS at program exit but the buffer of logfile may still
contain data which are "written" by the program but not yet commited
to do DOS. DOS's 'close' does not know that there are buffered data in
the TP program.

In this case it is advisable to flush it after every writeln.

        writeln(log,message);flush(log);

to be sure that everything what was "written" by the program up to the
possible Break/RTE will go to disk.

There is a trick to avoid the necessity of flush(log). _After_
resetting/appending a TEXT file use

        with textrec(f) do FlushFunc:=InOutFunc;

Now every write(f,..)-command will automatically execute an implicit
flush(f), i.e. it will behave as undelayed output to the screen.
 

Regards
Horst