home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / printer / printer.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-05-09  |  5.9 KB  |  179 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
  2. (*===================================================================*)
  3. (*                           PRINTER.PAS                             *)
  4. (*    Ersatz für die Unit PRINTER.PAS der Borland-Pascal Laufzeit-   *)
  5. (*                          Bibliothek                               *)
  6. (*-------------------------------------------------------------------*)
  7. (*  Die Unit sucht sich bei der Initialisierung den passenden ange-  *)
  8. (*  schlossenen aktiven Drucker mit der niedrigsten Schnittstellen-  *)
  9. (*  nummer automatisch aus. Ist kein Drucker angeschlossen, wird in  *)
  10. (*  eine Datei mit dem Namen PRINTFIL.LPT gedruckt.                  *)
  11. (*===================================================================*)
  12.  
  13. UNIT Printer;
  14.  
  15. INTERFACE
  16.  
  17. VAR
  18.   Lst: Text;
  19.  
  20. IMPLEMENTATION
  21. USES
  22.    Dos;
  23. {$IFNDEF Ver70}
  24. CONST
  25.   Seg0040: WORD = $40;
  26. {$ENDIF}
  27.  
  28. VAR
  29.   PrintFile: DirStr;
  30.  
  31. VAR
  32.   PrnNum: BYTE;
  33.   OldExitProc: Pointer;
  34.  
  35. PROCEDURE LstBinaryMode;    {  Procedure from Borland's Printer Unit  }
  36. INLINE(         { Nur als Inline, da der Assembler Lst.Handle ablehnt }
  37.   $8B/$1E/Lst/                                  { MOV   BX,Lst.Handle }
  38.   $B8/$00/$44/                                  { MOV   AX,4400H      }
  39.   $CD/$21/                                      { INT   21H           }
  40.   $80/$CA/$20/                                  { OR    DL,20H        }
  41.   $B6/$00/                                      { MOV   DH,0          }
  42.   $B8/$01/$44/                                  { MOV   AX,4401H      }
  43.   $CD/$21);                                     { INT   21H           }
  44.  
  45. FUNCTION NumOfPorts: BYTE;
  46. VAR
  47.   L1Adr, L2Adr,
  48.   L3Adr, L4Adr: WORD;
  49.   Num         : BYTE;
  50. BEGIN
  51.   Num := 0;
  52.   L1Adr := WORD(Ptr(Seg0040, $0008)^);                         { LPT1 }
  53.   L2Adr := WORD(Ptr(Seg0040, $000A)^);                         { LPT2 }
  54.   L3Adr := WORD(Ptr(Seg0040, $000C)^);                         { LPT3 }
  55.   L4Adr := WORD(Ptr(Seg0040, $000E)^);                         { LPT4 }
  56.   IF L1Adr <> 0 THEN Inc(Num);
  57.   IF L2Adr <> 0 THEN Inc(Num);
  58.   IF L3Adr <> 0 THEN Inc(Num);
  59.   IF L4Adr <> 0 THEN Inc(Num);
  60.   NumOfPorts := Num;
  61. END;
  62.  
  63. FUNCTION PrState(LPTNo: BYTE): BYTE;
  64. VAR
  65.   check: BYTE;
  66. BEGIN
  67.   IF LPTNo > 0 THEN BEGIN
  68.     IF LPTNo < 5 THEN BEGIN
  69.       Dec(LPTNo);
  70.       ASM
  71.         MOV AX, 0200h                      { Funktion 02h (AH)        }
  72.         MOV DL, LPTNo                      { Schnittstellennummer - 1 }
  73.         XOR DH, DH
  74.         INT 17h                            { Schnittstelleninterrupt  }
  75.         MOV check, AH                      { Rückgabe in AH           }
  76.       END;
  77.     END ELSE check := 2;
  78.   END ELSE check := 2;
  79.   PrState := check;
  80. END;
  81.  
  82. (*===================================================================*)
  83. (* Rückgabewerte: (NEC-Nadeldrucker u.a.)                            *)
  84. (*   0           =  Drucker wird gerade initialisiert -->            *)
  85. (*                  bitte warten!                                    *)
  86. (*   1           =  Drucker TimeOut                                  *)
  87. (*   2           =  Parallele Schnittstelle No. (LptNo) ist nicht    *)
  88. (*                  vorhanden                                        *)
  89. (*   8           =  Drucker ist nicht selektiert (unselect-Signal)   *)
  90. (*  16, 24       =  Drucker nicht bereit (z.T. auch: Drucker im      *)
  91. (*                  Grafikmodus)                                     *)
  92. (*  40           =  kein Papier (Paper-out Signal)                   *)
  93. (*  48           =  Schnittstelle ok und frei (kein Drucker          *)
  94. (*                  angeschlossen)                                   *)
  95. (*  56           =  Kabel am Rechner, aber kein externes Gerät       *)
  96. (*                  angeschlossen                                    *)
  97. (*  72, 184      =  Drucker aus                                      *)
  98. (*  80, 144, 208 =  Printer ON LINE                                  *)
  99. (* 200           =  Printer OFF LINE                                 *)
  100. (*===================================================================*)
  101.  
  102. FUNCTION SelectPrinter: BYTE;
  103. VAR
  104.   count, Number, check: BYTE;
  105. BEGIN
  106.   Number := $FF;                             { vorbelegt: Dateidruck! }
  107.   FOR count := NumOfPorts DOWNTO 1 DO
  108.   BEGIN
  109.                        { Schnittstelle mit niedrigster Nummer wählen: }
  110.    check := PrState(count);
  111.    IF check IN [80, 144, 208] THEN Number := count;
  112.   END;
  113.   SelectPrinter := Number;     { Druckerschnittstelle ist festgelegt }
  114. END;
  115.  
  116. {$F+}
  117. PROCEDURE PrinterExitProc;
  118. VAR
  119.  l: File OF BYTE;
  120. BEGIN
  121.   Close(Lst);
  122.   Assign(l, PRINTFILE);
  123.   Reset(l);
  124.   IF FileSize(l) = 0 THEN
  125.   BEGIN
  126.     Close(l);
  127.     Erase(l);
  128.   END
  129.   ELSE
  130.    Close(l);
  131.   ExitProc := OldExitProc;
  132. END;
  133. {$F-}
  134.  
  135. VAR
  136.   Year, Month, Day, DayofWeek,
  137.   Hour, Minute, Second, Sec100: WORD;
  138.   YearS, MonthS, DayS, HourS  : STRING;
  139.   PrgDir : DirStr;
  140.   PrgName: NameStr;
  141.   PrgExt : ExtStr;
  142.  
  143. BEGIN
  144.   PrnNum := SelectPrinter;
  145.   IF PrnNum = $FF THEN
  146.   BEGIN
  147.     PrgDir := '';
  148.     IF Lo(DosVersion) > 2 THEN
  149.       FSplit(ParamStr(0), PrgDir, PrgName, PrgExt);
  150.     GetDate(Year, Month, Day, DayofWeek);
  151.     GetTime(Hour, Minute, Second, Sec100);
  152.     Str(Year, YearS);
  153.     Delete(YearS, 1, 2);
  154.     Str(Month, MonthS);
  155.     Str(Day, DayS);
  156.     Str(Hour, HourS);
  157.     IF Length(DayS)   = 1 THEN DayS   := '0' + DayS;
  158.     IF Length(MonthS) = 1 THEN MonthS := '0' + MonthS;
  159.     PrintFile := PrgDir + DayS + MonthS + YearS + HourS + '.PRN';
  160.     Assign(Lst, PrintFile);
  161.     Rewrite(Lst);
  162.     OldExitProc := ExitProc;
  163.     ExitProc := @PrinterExitProc;
  164.   END
  165.   ELSE
  166.   BEGIN
  167.     CASE PrnNum OF
  168.       1:  Assign(Lst, 'LPT1');
  169.       2:  Assign(Lst, 'LPT2');
  170.       3:  Assign(Lst, 'LPT3');
  171.      ELSE Assign(Lst, 'LPT4');
  172.     END;
  173.     Rewrite(Lst);
  174.     LstBinaryMode;
  175.   END;
  176. END.
  177.  
  178. (*===================================================================*)
  179.