Monster Media 1994 #1/monster.zip/monster/PROG_PAS/LPT.ZIP/LPT.PAS

Pascal/Delphi Source File | 1993-12-22 | 14KB | 330 lines

{$R-,S-}
{
  ** LPT Unit **
  ** Copyright (c) 1988 Richard S. Sadowsky
  ** by Richard S. Sadowsky
  ** 1/12/88
  ** version 1.0

  Revised by
   Mark Reichert, 72763,2417
   11/1/93
   version 2.0
  The DOS references warn against relying on the Int 17 Bios function since
  only IBM and Epson printers and printers that are 100% compatible to them
  reliably send back the documented bits for all situations.  However, there
  are to very good reasons for using this unit.

  First, the reason to use this unit at all over the default use of the
  Int 21, Function 40 (Write to File or Device) is that that function
  doesn't check the buffer.  At least on the computer/printer setup in my
  office (DELL, HP LJ), part of a string will be put into the buffer before
  a DriveNotReady critical error message is sent back (remember, it's Write
  to File, as well as Device).  Thus part of line is already in the buffer
  with NO way to get it back off AND no way of telling how much of it is out
  there.  Just the usual fun provided by Microsoft.  Sending the output a
  character at a time lets you intercept a busy (buffer full) message and
  have the program wait beyond the timeout done by the Int 17 and printer.

  Second, I'm only relying on the printer and computer manufacturers not
  being malicious.  You will see so in my comment right before the code
  for the Out_Chars function that actually sends a line out to the printer.  }

unit Lpt;

interface

Uses Crt,    { Uses Delay }
     Dos,    { Uses fmOutput }
     IOChek; { Uses ErrorEnum OutOfPaper, etc. }
             { This unit is in Dos Programming in the BP CompuServe Library }

Type
  Strg5 = String[5];

  { Hook for third party to make their own screen environment compatible error box
    pop up with appropriate message for error code;  Escaped indicates whether the
    user 'escaped' out of box to end printing altogether }
  PrinterErrorProc = Procedure (Var ErrCode : Integer; Var Escaped : Boolean);

  { Hook for third party to write to their own log file to keep track of all error
    conditions including the ones being handled by the program like busy signals;
    Depending on unit variables set by procedures called from outside of the log unit,
    TypeOfMsg, an enum in my system, allows the LogProc to skip writing the LogStr.
    This way most of the time the Log would show only the most important (Major)
    messages, but through parameter strings or DOS environment variables, one
    could 'turn on' other (Minor) statements to get more information on the next run }
  PrinterLogProc   = Function (TypeOfMsg : Word; Const LogStr : String) : Integer;

const
  { Also have other values for whether to additionally Flush Buffer after write
    and whether to write another statement afterwards to show MemAvail and MaxAvail,
    but I want to keep this simple here }

  Major = 0;
  Minor = 1;
  LPTNames  : array[0..2] of Strg5 = ('LPT1'#0,'LPT2'#0,'LPT3'#0);

procedure AssignLst(var F : Text; LPTNumber : Word);
{ like Turbo's assign, except associates Text variable with one of the LPTs }

Procedure AssignPrintErrorHandler(PrintErrorHandler : PrinterErrorProc);

Procedure AssignLogHandler(LogHandler : PrinterLogProc);

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;

implementation

Const
  NumOfLinesBusy  : Word = 0;
  LPTErrorHandler : PrinterErrorProc = nil;
  LPTLogHandler   : PrinterLogProc   = nil;

{ This function returns numbers equal to the ordinal value of ErrorEnums from the
  IOCHEK unit, to assembler they're the same thing.

  As I state above, this function only assumes that the manufacturers are not
  malicious.  The first bit check is for NO PAPER, because I think that is the
  one bit no manufacturer would screw up.  The rest assume most other printers
  act like my HP LaserJet IIP+.

  Second, it checks for the SELECTED bit, the status of which sort of divides the
  recognized errors in two groups.  If it was set, the TIMEOUT bit is checked, and
  if it is NOT set, then the character went through fine and we can send another.
  If the TIMEOUT bit was set, it makes sure the NOT BUSY bit was NOT set.  This is
  really belt and suspenders safety; it was useless on my HP because that bit was
  never set, but it might be on others.  I'm only assuming that no printer would
  set it when the printer ACTUALLY IS busy.  A DriveNotReady error is noted because
  that is what the BP Critical Error Handler gave in this situation.

  Third, if the SELECTED bit is not set, the TIMEOUT bit is checked, and if it is
  set, then that meant that the machine was ON but OFFLINE and I figure that that
  would be true on most setups.  A DeviceWriteFault error is noted because that
  is what the BP Critical Error Handler gave in this situation.

  Last, both the SELECTED and TIMEOUT bits are not set, we have an unknown I/O error,
  so the I/O Error bit is checked and if it is set, then a UnknownCommand error number
  is sent back.  If it isn't, the actual byte sent back by the printer is return, so
  that the bits can be looked at by the main program. }

function Out_Chars(Var CurrBuffPtr : Pointer; Var NumOfChars : Word; LPTNo : Word) : Integer; assembler;
Asm
  mov BX, DS
  LDS SI, NumOfChars     { get location of NumOfChars variable }
  mov CX, [SI]           { load into CX for loop }
  LDS SI, CurrBuffPtr    { get location of CurrBuffPtr variable }
  LDS SI, [SI]           { get location of Buffer it is pointing to }
  mov DX, LPTNo          { get printer number - 0 = LPT1, 1 = LPT2, 2 = LPT3 }
  cld                    { make sure lodsb increments SI by clearing direction flag }
@LoopTop:                { start loop }
  lodsb                  { get char }
  mov AH, 00h            { set AH for BIOS int 17h function 0 }
  int 17h                {  do an int 17h to sent to printer }
  xchg AL, AH            { put byte result in AL }
  test AL, 100000b       { see if the No Paper flag is set }
  jz @HadPaper
  mov AL, OutOfPaper     { No Paper = OutOfPaper, enum is num to asm }
  jmp @Error
@HadPaper:
  test AL, 10000b        { see if the selected flag is not set }
  jz @NotSelected
  test AL, 01b           { see if the time out flag is set }
  jnz @Busy
  loop @LoopTop          { unless that was the last char, loop to the top }
  mov AL, NoError        { Selected and Not TimeOut = NoError, enum is num to asm }
  jmp @end
@Busy:
  test AL, 10000000b     { see if the busy flag is not set }
  jnz @Unknown
  mov AL, DriveNotReady  { Selected And TimeOut And Busy = DriveNotReady }
  jmp @Error               { DriveNotReady usually = Buffer Full, Printer Busy }
@NotSelected:
  test AL, 01b           { see if the time out flag is set }
  jz @Unknown
  mov AL, DeviceWriteFault { Not Selected and TimeOut = DeviceWriteFault }
  jmp @Error                  { DeviceWriteFault usually = OffLine }
@Unknown:
  test AL, 1000b         { see if the IO Error flag is set }
  jz @end                { just leave error in return if we can't identify it }
  mov AL, UnknownCommand { Not Selected And Not TimeOut and IO Error = UnknownCommand }
@Error:
  mov DI, SI             { by pointing DI back one char, the next run of Out_Chars }
  dec DI                 { will reload char that was last tried and didn't go thru }
  LDS SI, CurrBuffPtr    { get the location of the pointer to the buffer again }
  mov word ptr [SI], DI  { SEG same, offset has changed as LODSB has pulled of chars }
@end:
  LDS SI, NumOfChars
  mov word ptr [SI], CX  { return the number of chars left }
  xor AH, AH             { make AX = AL for return as integer }
  mov DS, BX
End;

function LstIgnore(var F : TextRec) : Integer; far;
{ A do nothing, no error routine }
begin
  LstIgnore := 0 { return 0 for IOResult }
end;

function LstOutput(var F : TextRec) : Integer; far;
{ Send whatever has accumulated in the Buffer to int 17h           }
{ If error occurs, return in IOResult.  See BP 7.0 Language Guide, }
{ Chapter 14, page 172 for more info on Text-File Device Drivers   }
var
  I, NumOfCharsBusy,
  NoOfChars  : Word;
  CurBufPtr  : Pointer;
  ErrorCode  : Integer;
  Escaped,
  ProcessError : Boolean;
begin
  LstOutput := 0;
  NumOfCharsBusy := 0;
  with F do
    begin
      { if the file has not been opened for Output, send an error number }
      If Mode = fmOutput Then
        Begin
          I := 0;
          NoOfChars := BufPos;
          CurBufPtr := BufPtr;
          Repeat
            { send chars to printer }
            ErrorCode := Out_Chars(CurBufPtr, NoOfChars, LPTNo);
            if ErrorCode <> Ord(NoError) then
              begin { if error }
                ProcessError := True;
                If ErrorCode = Ord(DriveNotReady) Then
                  Begin
                    ProcessError := False;
                    { The first five busy characters in a line are handled
                      here.  5 is an arbitrary number and can be changed }
                    If NumOfCharsBusy < 5 Then
                      Begin
                       { if the handler hasn't been given, don't attempt it }
                        If Assigned(LPTLogHandler) Then
                          LPTLogHandler(Major, 'Char was Busy');
                        Delay(100);
                        Inc(NumOfCharsBusy);
                      End
                    Else
                    { The first 2 lines of 5 busy characters each are handled
                      here.  2 is an arbitrary number and can be changed }
                      If NumOfLinesBusy < 2 Then
                        Begin
                          If Assigned(LPTLogHandler) Then
                            LPTLogHandler(Major, 'Line was Busy');
                          NumOfCharsBusy := 0;
                          Delay(500);
                          Inc(NumOfLinesBusy);
                        End
                      Else
                    { If more than 2 lines of 5 busy characters are recieved
                      then we should tell the user who might want to attempt
                      to print later. }
                        ProcessError := True;
                  End;
                If ProcessError Then
                  Begin
                    Escaped := False;
                    NumOfLinesBusy := 0;
                    { if the handler hasn't been given, don't attempt it }
                    If Assigned(LPTErrorHandler) Then
                      LPTErrorHandler(ErrorCode, Escaped)
                    Else
                      Escaped := True;
                    If Escaped Then
                      Begin
                       { If BufPos <> 0, next writeln will put chars at end
                         of current chars in buffer }
                        BufPos := 0;
                        LstOutput := ErrorCode;    { return errorcode in IOResult }
                        Exit                       { return from function }
                      End;
                  End;
              end;
          Until (ErrorCode = 0) and (NoOfChars <= 0);
          { at this point, the line should have gone through successfully }
        end
      Else
        LstOutput := Ord(FileNotOpenForOutput);
      BufPos := 0;
    End;
end;

{ This is one place where Mr. Sadowsky's version was inconsistent with the
  'correct' usage, or at least the way Turbo Vision uses TFDD's to write to
  a message window on the screen.  First, it is the LstOpen function setup
  by Assign and called by Reset or Rewrite that sets InOutFunc and FlushFunc,
  and not Assign.  Second, it is not a good idea to set FlushFunc to LstOutput
  if there is any chance that the programmer will try to 'close' the printer.
  Doing so will cause a random memory dump as a nonexistant, at this point,
  buffer is written to the printer. }

function LstOpen(var F : TextRec) : Integer; far;
begin
  with F do
  begin
    if Mode = fmOutput then
    begin
      InOutFunc := @LstOutPut;

      { making FlushFunc = InOutFunc caused closing the file to try to print
        garbage from the buffer, since BP's Close calls Flush.  I don't think
        that we need flush for printing so.. }
      FlushFunc := @LstIgnore;
    end;
  End;
  LstOpen := 0 { return 0 for IOResult }
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
    Handle     := $FFFF;      { this is not a file, it has no real handle }
    Mode       := fmClosed;   { but it should be 'opened' through a Rewrite }
    BufSize    := SizeOf(Buffer);
    BufPtr     := @Buffer;
    OpenFunc   := @LstOpen; { LstOpen assigns the InOutFunc and FlushFunc }
    CloseFunc  := @LstIgnore; { you don't close the printer }
    LPTNo      := LPTNumber;  { user selected printer num (in [0..2]) }
    Move(LPTNames[LPTNumber][1],Name,5); { set name of device }
    BufPos := 0; { reset BufPos }
  end;
end;

Procedure AssignPrintErrorHandler(PrintErrorHandler : PrinterErrorProc);
Begin
  LPTErrorHandler := PrintErrorHandler;
End;

Procedure AssignLogHandler(LogHandler : PrinterLogProc);
Begin
  LPTLogHandler := LogHandler;
End;

end.