home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / BONUS507.ZIP / LPT.ARC / LPT.PAS next >
Encoding:
Pascal/Delphi Source File  |  1988-10-10  |  4.4 KB  |  141 lines
  1. {$R-,S-}
  2. {
  3.   ** LPT Unit **
  4.   ** Copyright (c) 1988 Richard S. Sadowsky
  5.   ** by Richard S. Sadowsky
  6.   ** 1/12/88
  7.   ** version 1.0
  8. }
  9.  
  10. {$DEFINE AssignLstDevice}
  11.  
  12. unit Lpt;
  13.  
  14. interface
  15.  
  16. const
  17.   fmClosed         = $D7B0; { magic numbers for Turbo }
  18.   fmInput          = $D7B1;
  19.   fmOutput         = $D7B2;
  20.   fmInOut          = $D7B3;
  21.  
  22.   IO_Invalid       = $FC;    { invalid operation eg. attempt to write }
  23.                              { to a file opened in fmInput mode       }
  24.  
  25.   LPTNames         : array[0..2] of String[4] = ('LPT1','LPT2','LPT3');
  26.  
  27. var
  28.   Lst              : Text;   { for source compatability with TP3 }
  29.  
  30. function DoInt17(Ch : Char; LPTNo : Word) : Byte;
  31. { send a character to LPTNo via ROM BIOS int 17h func 0h }
  32. { implented as an inline "macro" for speed and the heck  }
  33. { of it! Bet you've seen this routine before!            }
  34. Inline(
  35.   $5A/         {  pop     DX    ; get printer number}
  36.   $58/         {  pop     AX    ; get char}
  37.   $B4/$00/     {  mov     AH,00 ; set AH for BIOS int 17h function 0}
  38.   $CD/$17/     {  int     $17   ; do an int 17h}
  39.   $86/$E0);    {  xchg    AL,AH ; put byte result in AL}
  40.  
  41. procedure AssignLst(var F : Text; LPTNumber : Word);
  42. { like Turbo's assign, except associates Text variable with one of the LPTs }
  43.  
  44. implementation
  45.  
  46. type
  47.   TextBuffer       = array[0..127] of Char;
  48.  
  49.   TextRec          = record
  50.                        Handle     : Word;
  51.                        Mode       : Word;
  52.                        BufSize    : Word;
  53.                        Private    : Word;
  54.                        BufPos     : Word;
  55.                        BufEnd     : Word;
  56.                        BufPtr     : ^TextBuffer;
  57.                        OpenFunc   : Pointer;
  58.                        InOutFunc  : Pointer;
  59.                        FlushFunc  : Pointer;
  60.                        CloseFunc  : Pointer;
  61.                        { 16 byte user data area, I use 4 bytes }
  62.                        PrintMode  : Word;  { not currently used}
  63.                        LPTNo      : Word;  { LPT number in [0..2] }
  64.                        UserData   : array[1..12] of Char;
  65.                        Name       : array[0..79] of Char;
  66.                        Buffer     : TextBuffer;
  67.                      end;
  68.  
  69. procedure Out_Char(Ch : Char; LPTNo : Word; var ErrorCode : Integer);
  70. { call macro to send char to LPTNo.  If bit 4, the Printer Selected bit }
  71. { is not set upon return, it is assumed that an error has occurred.     }
  72.  
  73. begin
  74.   ErrorCode := DoInt17(Ch,LPTNo);
  75.   if (ErrorCode and $10) = $10 then { if bit 4 is set }
  76.     ErrorCode := 0                  { no error }
  77.   { if bit 4 is not set, error is passed untouched and placed in IOResult }
  78. end;
  79.  
  80. {$F+} { <==The following routines MUST be compiler as FAR }
  81.  
  82. function LstIgnore(var F : TextRec) : Integer;
  83. { A do nothing, no error routine }
  84. begin
  85.   LstIgnore := 0 { return 0 for IOResult }
  86. end;
  87.  
  88. function LstOutput(var F : TextRec) : Integer;
  89. { Send whatever has accumulated in the Buffer to int 17h   }
  90. { If error occurs, return in IOResult.  See Inside Turbo   }
  91. { Pascal chapter of TP4 manual for more info on TFDD       }
  92. var
  93.   I                : Word;
  94.   ErrorCode        : Integer;
  95.  
  96. begin
  97.   LstOutput := 0;
  98.   with F do begin
  99.     for I := 0 to Pred(BufPos) do begin
  100.       Out_Char(BufPtr^[I],LPTNo,ErrorCode); { send each char to printer }
  101.       if ErrorCode <> 0 then begin { if error }
  102.         LstOutput := ErrorCode;    { return errorcode in IOResult }
  103.         Exit                       { return from function }
  104.       end
  105.     end;
  106.     BufPos := 0
  107.   end;
  108. end;
  109.  
  110. {$F-} { Near ok now }
  111.  
  112.  
  113. procedure AssignLst(var F : Text; LPTNumber : Word);
  114. { like Turbo's assign, except associates Text variable with one of the LPTs }
  115.  
  116. begin
  117.   with TextRec(F) do begin
  118.     Mode       := fmClosed;
  119.     BufSize    := SizeOf(Buffer);
  120.     BufPtr     := @Buffer;
  121.     OpenFunc   := @LstIgnore; { you don't open the BIOS printer functions }
  122.     CloseFunc  := @LstIgnore; { nor do you close them }
  123.     InOutFunc  := @LstOutput; { but you can Write to them }
  124.     FlushFunc  := @LstOutput; { and you can WriteLn to them }
  125.     LPTNo      := LPTNumber;  { user selected printer num (in [0..2]) }
  126.     Move(LPTNames[LPTNumber],Name,4); { set name of device }
  127.     BufPos := 0; { reset BufPos }
  128.   end;
  129. end;
  130.  
  131. begin
  132.  
  133. {$IFDEF AssignLstDevice}
  134.  
  135.   AssignLst(Lst,0); { set up turbo 3 compatable Lst device }
  136.   Rewrite(Lst);
  137.  
  138. {$ENDIF}
  139.  
  140. end.
  141.