ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/MISCPAS.ZIP/PRNDRV.PQS/PRNDRV.PAS

Pascal/Delphi Source File | 1992-01-02 | 7.0 KB | 213 lines

{downloaded by Toad Hall from Delaware FIDO, 9 Feb 86.
 author unknown.  Assumed to be public domain release,
 with usual "no commercial use, no sale for profit" constraints.
 PC or clone peculiar right now because of the video memory
 locations in the code and the keyboard interrupt 16H
 (but could be hacked for other setups or displays easily).
 David Kirschbaum
 Toad Hall
 [e-mail]
}

  {
  PRNDRV.PAS
  printer driver to provide clean error handling
  modification of Kim Kokkonen's TUFPRT, to include his later
  changes, some corrections to error handling, & restore of display
  after error message
  }

PROGRAM PRNDRV;               { including test program }

  TYPE
    Printers = (LPT1, LPT2, LPT3, LPT4, NoPrinter);
  CONST
    ActivePrinter : Printers = NoPrinter;
  VAR
    SavePrintTimeOut : Byte;
    {
    the following bytes normally equal $14, providing 20 retries on printer
    busy calls. Set to 1 for a single retry (timeout takes about 2 seconds).
    Do not set to 0 or system will retry forever.
    }
    PrintTimeOut : ARRAY[Printers] OF Byte ABSOLUTE $40 : $78;

  PROCEDURE PrintChar(ch : Char);
      {-print the character ch, handle errors & loop when busy }
      {
      **********************************************************************
      CANNOT USE TURBO I/O FUNCTIONS INSIDE HERE DUE TO RE-ENTRANCY PROBLEMS
      **********************************************************************
      }

    TYPE
      PrintErrors =
      (TimeOut, unused1, unused2, IOerror, Selected,
      OutOfPaper, Acknowledge, Busy, NoError);

      DisplayString = STRING[80];

      registers =
      RECORD
        CASE Integer OF
          1 : (ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer);
          2 : (al, ah, bl, bh, cl, ch, dl, dh : Byte);
      END;

    CONST
      PrintErrorMsg : ARRAY[PrintErrors] OF DisplayString =
      ('Printer Timeout Error', '', '', 'Printer Not Selected',
      'Printer Not Selected', 'Printer Out of Paper',
      'Printer Acknowledge Error', 'Printer Busy', '');

      EndStr : DisplayString = #13#10#36;

      {maximum number of replies with busy before calling it a timeout error.
      may need to be adjusted empirically to avoid false timeouts}
      BusyMax = 100;

    VAR
      reg : registers;
      Error : PrintErrors;
      BusyCount : Integer;
    VAR err : Byte;


    PROCEDURE writestring(s : DisplayString);
        {-write string to standard output}
      VAR
        reg : registers;
      BEGIN
        reg.ah := 9;
        reg.ds := Seg(s);
        reg.dx := Ofs(s[1]);
        MsDos(reg);
      END;                    {displaystring}

    PROCEDURE getchar(VAR response : Char);
        {-get a character from the keyboard}
      VAR
        reg : registers;
      BEGIN
        reg.ah := 0;
        Intr($16, reg);
        response := Chr(reg.al);
      END;                    {getchar}


    PROCEDURE HandleError(Error : PrintErrors);
        {-handle user-oriented error conditions}
      TYPE
        ScreenContents = ARRAY[1..4000] OF Byte;
      VAR
        CrtMode : Byte ABSOLUTE $0040 : $0049;
        MonoBuffer : ScreenContents ABSOLUTE $B000 : $0000;
        ColorBuffer : ScreenContents ABSOLUTE $B800 : $0000;
        savescreen : ScreenContents;
        response : Char;
      BEGIN
        IF CrtMode = 7 THEN
          savescreen := MonoBuffer
        ELSE
          savescreen := ColorBuffer; { save screen contents }
        writestring(PrintErrorMsg[Error]+EndStr);
        writestring('Correct condition and then press <ENTER> '+#36);
        REPEAT getchar(response) UNTIL (response IN [#13, #3]);
        writestring(EndStr);
        IF response = #3 THEN Halt; {Ctrl-C}
        BusyCount := 0;
        IF CrtMode = 7 THEN
          MonoBuffer := savescreen
        ELSE
          ColorBuffer := savescreen; { restore screen contents }
      END;                    {handleerror}

    PROCEDURE int17(Printer : Printers; func : Byte;
                    CharToPrint : Byte; VAR err : Byte);
        {-call the printer interrupt and return error information}
        {-func =0 to print, =2 to just check status}
      BEGIN
        INLINE(
          $8B/$56/$0C/        {MOV    DX,[BP+0C] - get printer number}
          $8A/$66/$0A/        {MOV    AH,[BP+0A] - get printer function}
          $8A/$46/$08/        {MOV    AL,[BP+08] - get character to print}
          $CD/$17/            {INT    17}
          $C4/$7E/$04/        {LES    DI,[BP+04] - get address of error}
          $26/$88/$25);       {MOV    ES:[DI],AH - return error if any}
      END;                    {int17}


    BEGIN                     { PrintChar }
      IF ActivePrinter = NoPrinter THEN BEGIN
        writestring('program error: no printer is selected'+EndStr);
        Exit;
      END;
      reg.dx := Ord(ActivePrinter); {equals 0..3}
      BusyCount := 0;

      REPEAT
        {print the character}
        int17(ActivePrinter, 0, Ord(ch), err);
        {check for errors}
        IF (err AND 128) <> 0 THEN BEGIN
          {printer busy}
          BusyCount := Succ(BusyCount);
          IF BusyCount < BusyMax THEN
            Error := Busy
          ELSE BEGIN
            {busy too long, call it a timeout}
            HandleError(TimeOut);
            Error := TimeOut;
          END;
        END ELSE IF (err AND 41) <> 0 THEN BEGIN
          {a "hard" error}
          IF (err AND 32) <> 0 THEN
            HandleError(OutOfPaper)
          ELSE IF (err AND 8) <> 0 THEN
            HandleError(IOerror)
          ELSE HandleError(TimeOut);
          Error := IOerror;
        END ELSE
          Error := NoError;
      UNTIL Error = NoError;
    END;                      {printchar}


  PROCEDURE ProtectPrinter(Printer : Printers);
      {-define the Lst device to print to the specified printer}
    BEGIN
      IF ActivePrinter = NoPrinter THEN BEGIN
        ActivePrinter := Printer;
        LstOutPtr := Ofs(PrintChar);
        {save current printer timeout}
        SavePrintTimeOut := PrintTimeOut[Printer];
        {set to minimum timeout period}
        PrintTimeOut[Printer] := 1;
      END ELSE
        WriteLn(Con,
        'program error: only one printer can be protected at a time');
    END;                      {protectprinter}

  PROCEDURE RestorePrinter;
      {-deassign the Lst device and restore the printer timeout}
    BEGIN
      IF ActivePrinter <> NoPrinter THEN BEGIN
        PrintTimeOut[ActivePrinter] := SavePrintTimeOut;
        ActivePrinter := NoPrinter;
      END;
    END;                      {restoreprinter}

    {end of include portion
    ***********************************************************************}

    {demonstration follows}
  VAR
    i : Integer;
  BEGIN
    ProtectPrinter(LPT1);
    FOR i := 1 TO 25 DO
      {any writes to the Lst device are now protected}
      WriteLn(Lst, 'hello hello hello hello');
    RestorePrinter;
  END.