home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / LPT123.ZIP / LPT123.PAS next >
Encoding:
Pascal/Delphi Source File  |  1988-12-09  |  6.9 KB  |  196 lines
  1. {$S-,I-,V-,E-}
  2. UNIT LPT123;
  3. {
  4.   MODULE:    LPT123.PAS
  5.   AUTHOR:    L. Christopher Luther, ProLogic Consultants
  6.   DATE:      December 1, 1988
  7.  
  8.   PURPOSE:   The purpose of this Unit is to provide a generic printer
  9.            interface for all Turbo Pascal 5.0 (and 4.0 if you remove the
  10.            E- compiler directive) programs.  I feel that it fills a few
  11.            gaps that Borland forgot to include in their Printer Unit.
  12.  
  13.            Two of the routines, Eject_A_Page and PrinterStatus, were
  14.            obtained from the last issue of the Turbo User's Group Magazine,
  15.            "TUG Lines."  Eject_A_Page is sooooo simple that I could not
  16.            improve it.  However, PrinterStatus did not load the number of
  17.            the printer into register DX.  As a result, the routine was not
  18.            consistent in its operation.  I modified it around the other
  19.            functions that I wrote so that it will report the status of
  20.            whichever printer port is currently open.
  21.  
  22.            I hope that this routine is the first step to others sharing
  23.            their code.  I welcome comments and improvements.  Maybe someone
  24.            could write a set BIOS routines to make the LST output faster.
  25.  
  26. }
  27.  
  28. {=============================================================================}
  29. INTERFACE
  30.  
  31. CONST
  32.   PrtNoError     = 0;                  { No printer error detected  }
  33.   PrtInUse       = 1;                  { Printer busy error         }
  34.   PrtNotSelected = 2;                  { Printer not on line error  }
  35.   PrtNoPaper     = 3;                  { Printer out of paper error }
  36.   PrtNoPower     = 4;                  { Printer no power error     }
  37.   PrtMiscError   = 5;                  { Unknown printer error      }
  38.  
  39. VAR
  40.   Lst : TEXT;
  41.  
  42. PROCEDURE SetLstMode (Raw : BOOLEAN);   { Toggle Cooked/Raw mode for Lst  }
  43. PROCEDURE AssignLst (LstPort : BYTE);   { Open LPT1: through LPT3:        }
  44. PROCEDURE Eject_a_Page;                 { Send a form feed to Lst         }
  45. FUNCTION PrinterStatus : INTEGER;       { Attempt to determine Lst status }
  46.  
  47. {=============================================================================}
  48. IMPLEMENTATION
  49.  
  50. USES
  51.   DOS;
  52.  
  53. CONST
  54.   FirstTime     : BOOLEAN = TRUE;      { A simple switch (see AssignLst). }
  55.  
  56. VAR
  57.   Regs          : REGISTERS;           { We need these registers.         }
  58.   ExitSave      : POINTER;             { Pointer to old Exit Proc.        }
  59.   OldLstMode    : BOOLEAN;             { Old status of Lst Raw or Cooked. }
  60.   LstFileHandle : WORD Absolute Lst;   { The file handle for the LST Text }
  61.                                 {   Device Driver.                 }
  62.  
  63.  
  64. {*****************************************************************************}
  65. FUNCTION GetLstMode : BOOLEAN;
  66. BEGIN
  67.   WITH Regs DO
  68.     BEGIN
  69.       AX := $4400;                     { Get device status      }
  70.       BX := LstFileHandle;             { Lst device handle      }
  71.      MSDOS (Regs);                    { Call INT 21 Function   }
  72.       GetLstMode := Odd(DX Shr 5);     { Get the current status }
  73.     END;                               {   of the Raw Bit       }
  74. END;
  75.  
  76.  
  77. {*****************************************************************************}
  78. PROCEDURE SetLstMode (Raw : BOOLEAN);
  79. BEGIN
  80.   WITH Regs DO
  81.     BEGIN
  82.      AX := $4400;                     { Get device status     }
  83.      BX := LstFileHandle;             { Lst device handle     }
  84.      MSDOS (Regs);                    { Call INT 21 Function  }
  85.       AX := $4401;                     { Set device status     }
  86.      DX := DX AND $00DF;              { Clear the Raw Bit     }
  87.      IF Raw THEN
  88.        Inc (DX, 32);
  89.      MSDOS (Regs);                    { Call INT 21 Function  }
  90.     END;
  91. END;
  92.  
  93.  
  94. {*****************************************************************************}
  95. {$F+}
  96. PROCEDURE ExitHandler;
  97. BEGIN
  98.   ExitProc := ExitSave;                { Restore old Exit Proc Pointer.    }
  99.   SetLstMode (OldLstMode);             { Restore Lst to its old status.    }
  100.   Close (Lst);                         { Close the LST Text Device Driver. }
  101. END;
  102. {$F-}
  103.  
  104.  
  105. {*****************************************************************************}
  106. PROCEDURE AssignLst (LstPort : BYTE);
  107.  
  108. VAR
  109.   LptName  : STRING[4];
  110.   DummyErr : WORD;
  111.  
  112. BEGIN
  113.   IF NOT FirstTime THEN                { If this is not the first time that }
  114.     BEGIN                              {   the routine is executed, then    }
  115.      SetLstMode (OldLstMode);         {   restore the Raw/Cooked status of }
  116.      Close (Lst);                     {   LPT? and close the device.       }
  117.      DummyErr := IOResult;            { We do not care if any IO Errors    }
  118.     END                                {   occur.                           }
  119.   ELSE
  120.     FirstTime := FALSE;
  121.  
  122.   CASE LstPort OF
  123.     1 : LptName := 'LPT1';
  124.     2 : LptName := 'LPT2';
  125.     3 : LptName := 'LPT3';
  126.     ELSE
  127.      LptName := 'LPT1';               { Default to LPT1 if invalid port }
  128.   END;
  129.  
  130.   Assign (Lst, LptName);
  131.   WITH TextRec(Lst) DO
  132.     BEGIN
  133.       CASE LstPort OF
  134.        1 : UserData[1] := 0;          { Store the LPT port in UserData[1] }
  135.                                 {   DOS uses 0 for LPT1:            }
  136.        2 : UserData[1] := 1;          { Store the LPT port in UserData[1] }
  137.                                 {   DOS uses 1 for LPT2:            }
  138.        3 : UserData[1] := 2;          { Store the LPT port in UserData[1] }
  139.                                 {   DOS uses 2 for LPT3:            }
  140.         ELSE
  141.         UserData[1] := 0;            { Store the LPT port in UserData[1] }
  142.                                 {   DOS uses 0 for LPT1:            }
  143.      END;
  144.     END;
  145.  
  146.   ReWrite (Lst);                       { Open the LST Text Device Driver.   }
  147.   DummyErr := IOResult;                { We do not care what errors occur.  }
  148.   OldLstMode := GetLstMode;            { Save the Raw/Cooked Status of LST. }
  149. END;
  150.  
  151.  
  152. {*****************************************************************************}
  153. PROCEDURE Eject_a_Page;
  154.  
  155. CONST
  156.   FormFeed = #12;
  157.  
  158. BEGIN
  159.   Write (Lst, FormFeed);               { Real simple, Eject one page }
  160. END;
  161.  
  162.  
  163. {*****************************************************************************}
  164. FUNCTION PrinterStatus : INTEGER;
  165.  
  166. { See the DOS technical Reference for the values of the Bits that are set
  167.   in register AH by this function.                                         }
  168.  
  169. BEGIN
  170.   WITH Regs DO
  171.     BEGIN
  172.      AH := $02;                       { Printer status function code.  }
  173.      DX := TextRec(Lst).UserData[1];
  174.      Intr ($17, Regs);                { Printer service interrupt.     }
  175.      CASE AH OF
  176.        $90 : PrinterStatus := PrtNoError;
  177.        $A1 : PrinterStatus := PrtInUse;
  178.        $08 : PrinterStatus := PrtNotSelected;
  179.        $28 : PrinterStatus := PrtNoPaper;
  180.        $48 : PrinterStatus := PrtNoPower;  { for IBM XT }
  181.        ELSE
  182.         PrinterStatus := PrtMiscError;
  183.      END;
  184.     END;
  185. END;
  186.  
  187.  
  188. {=============================================================================}
  189. { Unit INITIALIZATION }
  190.  
  191. BEGIN
  192.   AssignLst (1);                       { Open LST as LPT1:          }
  193.   ExitSave := ExitProc;                { Save the current Exit Proc.}
  194.   ExitProc := @ExitHandler             { Install our own Exit Proc. }
  195. END.
  196.