[Back to PRINTING SWAG index] [Back to Main SWAG index] [Original]
{ Can be used as a TOTAL replacement for the PRINTER UNIT }
{ You'll need to replace the PRINTER unit in the TURBO.TPL to use this }
{$S-,R-,V-,I-,N-,B-,F-}
{$IFNDEF Ver40}
{$F+,O-,X+,A-}
{$ENDIF}
{$DEFINE AssignLstDevice}
{$DEFINE DoErrorChecking} { undefine this to eliminate error checking }
UNIT Printer;
INTERFACE
{$IFDEF DoErrorChecking}
USES CRT;
{$ENDIF}
CONST
fmClosed = $D7B0; { magic numbers for Turbo }
fmInput = $D7B1;
fmOutput = $D782;
fmInOut = $D7B3;
IO_Invalid = $FC; { invalid operation eg. attempt to write }
{ to a file opened in fmInput mode }
LPTNames : ARRAY [0..2] OF STRING [4] = ('LPT1', 'LPT2', 'LPT3');
LPTPort : BYTE = 0;
VAR
Lst : TEXT; { for source compatability with TP3 }
FUNCTION GetROMPrinterStatus (LPTNo : WORD) : BYTE;
{ status of LPTNo via ROM BIOS int 17h func 2h }
INLINE (
$5A / { pop DX ; get printer number}
$B4 / $02 / { mov AH,02 ; set AH for BIOS int 17h function 0}
$CD / $17 / { int $17 ; do an int 17h}
$86 / $E0); { xchg AL,AH ; put byte result in AL}
FUNCTION DoInt17 (Ch : CHAR; LPTNo : WORD) : BYTE;
{ send a character to LPTNo via ROM BIOS int 17h func 0h }
INLINE (
$5A / { pop DX ; get printer number}
$58 / { pop AX ; get char}
$B4 / $00 / { mov AH,00 ; set AH for BIOS int 17h function 0}
$CD / $17 / { int $17 ; do an int 17h}
$86 / $E0); { xchg AL,AH ; put byte result in AL}
PROCEDURE AssignLst (VAR F : TEXT; LPTNumber : WORD);
{ like Turbo's assign, except associates Text variable with one of the LPTs }
PROCEDURE OutputToFile (FName : STRING);
{redirect printer output to file }
FUNCTION PrinterStatus (LPTNum : BYTE) : BYTE;
FUNCTION Printer_OK : BOOLEAN;
PROCEDURE SelectPrinter (LPTNum : BYTE);
PROCEDURE ResetPrinter; { only resets printer 0 }
IMPLEMENTATION
TYPE
TextBuffer = ARRAY [0..127] OF CHAR;
TextRec = RECORD
Handle : WORD;
Mode : WORD;
BufSize : WORD;
Private : WORD;
BufPos : WORD;
BufEnd : WORD;
BufPtr : ^TextBuffer;
OpenFunc : POINTER;
InOutFunc : POINTER;
FlushFunc : POINTER;
CloseFunc : POINTER;
{ 16 byte user data area, I use 4 bytes }
PrintMode : WORD; { not currently used}
LPTNo : WORD; { LPT number in [0..2] }
UserData : ARRAY [1..12] OF CHAR;
Name : ARRAY [0..79] OF CHAR;
Buffer : TextBuffer;
END;
CONST
LPTFileopen : BOOLEAN = FALSE;
VAR
LPTExitSave : POINTER;
PROCEDURE Out_Char (Ch : CHAR; LPTNo : WORD; VAR ErrorCode : INTEGER);
{ call macro to send char to LPTNo. If bit 4, the Printer Selected bit }
{ is not set upon return, it is assumed that an error has occurred. }
BEGIN
ErrorCode := DoInt17 (Ch, LPTNo);
IF (ErrorCode AND $10) = $10 THEN { if bit 4 is set }
ErrorCode := 0 { no error }
{ if bit 4 is not set, error is passed untouched and placed in IOResult }
END;
FUNCTION LstIgnore (VAR F : TextRec) : INTEGER;
{ A do nothing, no error routine }
BEGIN
LstIgnore := 0 { return 0 for IOResult }
END;
FUNCTION LstOutput (VAR F : TextRec) : INTEGER;
{ Send whatever has accumulated in the Buffer to int 17h }
{ If error occurs, return in IOResult. See Inside Turbo }
{ Pascal chapter of TP4 manual for more info on TFDD }
VAR
I : WORD;
ErrorCode : INTEGER;
BEGIN
LstOutput := 0;
{$IFDEF DOERRORCHECKING}
WHILE NOT Printer_OK DO
BEGIN
GotoXY(1,23);ClrEol;
Write('Please check Printer, and press any key when ready...');
Readkey;
END;
{$ENDIF}
WITH F DO BEGIN
FOR I := 0 TO PRED (BufPos) DO
BEGIN
Out_Char (BufPtr^ [I], LPTNo, ErrorCode); { send each char to printer }
IF ErrorCode <> 0 THEN BEGIN { if error }
LstOutput := ErrorCode; { return errorcode in IOResult }
EXIT { return from function }
END
END;
BufPos := 0
END;
END;
PROCEDURE AssignLst (VAR F : TEXT; LPTNumber : WORD);
{ like Turbo's assign, except associates Text variable with one of the LPTs }
BEGIN
WITH TextRec (F) DO
BEGIN
Mode := fmClosed;
BufSize := SIZEOF (Buffer);
BufPtr := @Buffer;
OpenFunc := @LstIgnore; { you don't open the BIOS printer functions }
CloseFunc := @LstIgnore; { nor do you close them }
InOutFunc := @LstOutput; { but you can Write to them }
FlushFunc := @LstOutput; { and you can WriteLn to them }
LPTNo := LPTNumber; { user selected printer num (in [0..2]) }
MOVE (LPTNames [LPTNumber], Name, 4); { set name of device }
BufPos := 0; { reset BufPos }
END;
END;
PROCEDURE OutputToFile (FName : STRING);
BEGIN
ASSIGN (Lst, FName);
REWRITE (Lst);
LPTFileopen := TRUE;
END;
FUNCTION PrinterStatus (LPTNum : BYTE) : BYTE;
VAR
Status : BYTE;
BEGIN
Status := GetROMPrinterStatus (LPTNum);
IF (Status AND $B8) = $90 THEN
PrinterStatus := 0 {all's well}
ELSE IF (Status AND $20) = $20 THEN
PrinterStatus := 1 {no Paper}
ELSE IF (Status AND $10) = $00 THEN
PrinterStatus := 2 {off line}
ELSE IF (Status AND $80) = $00 THEN
PrinterStatus := 3 {busy}
ELSE IF (Status AND $08) = $08 THEN
PrinterStatus := 4; {undetermined error}
END;
FUNCTION Printer_OK : BOOLEAN;
VAR
Retry : BYTE;
BEGIN
Retry := 0;
WHILE (PrinterStatus (LPTPort) <> 0) AND (Retry < 255) DO INC (Retry);
Printer_OK := (PrinterStatus (LPTPort) = 0);
END; {PrinterReady}
PROCEDURE SelectPrinter (LPTNum : BYTE);
BEGIN
IF (LPTNum >= 0) AND (LPTNum <= 3) THEN
LPTPort := LPTNum;
AssignLst (Lst, LPTPort); { set up turbo 3 compatable Lst device }
REWRITE (Lst);
END;
PROCEDURE ResetPrinter;
VAR
address : INTEGER ABSOLUTE $0040 : $0008;
portno, DELAY : INTEGER;
BEGIN
portno := address + 2;
Port [portno] := 232;
FOR DELAY := 1 TO 2000 DO {nothing} ;
Port [portno] := 236;
END; {ResetPrinter}
PROCEDURE LptExitHandler; FAR;
BEGIN
IF LPTFileopen THEN CLOSE (Lst);
ExitProc := LPTExitSave;
END;
BEGIN
LPTExitSave := ExitProc;
ExitProc := @LptExitHandler;
{$IFDEF AssignLstDevice}
LPTPort := 0;
AssignLst (Lst, LPTPort); { set up turbo 3 compatable Lst device }
REWRITE (Lst);
{$ENDIF}
{$IFDEF DOERRORCHECKING}
WHILE NOT Printer_OK DO
BEGIN
GotoXY(1,23);ClrEol;
Write('Please check Printer, and press any key when ready...');
Readkey;
END;
{$ENDIF}
END.
[Back to PRINTING SWAG index] [Back to Main SWAG index] [Original]