home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 09_10 / tricks / printers.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-11  |  2.0 KB  |  99 lines

  1.  {* * * * * * * * * * * * * * * * * * * *
  2.   *                                     *
  3.   *    UNIT:     PRINTERS               *
  4.   *    ersetzt die Standard-Unit        *
  5.   *    PRINTER für den Anschluß von     *
  6.   *    zwei Druckern an LPT1 und LPT2   *
  7.   *                                     *
  8.   *                                     *
  9.   *  Turbo Pascal  dt. 6.0 - P91123423  *
  10.   *    MS-DOS 4.01     TEMA 386-SX      *
  11.   *                                     *
  12.   *            (c) Mai 1991             *
  13.   *       Karl Friedrich  Wieneke       *
  14.   *          An der Tiefburg 6          *
  15.   *          D-6900 Heidelberg          *
  16.   *          Tel: 06221-413692          *
  17.   *                                     *
  18.   * * * * * * * * * * * * * * * * * * * *}
  19.  
  20.  
  21. unit printers;
  22.  
  23. interface
  24.  
  25. uses dos;
  26.  
  27. var lst, lst2   : text;
  28.  
  29. function  whichlst : shortint;
  30. procedure swaplst;
  31.  
  32.  
  33. implementation
  34.  
  35. const lst_no_error = 144;
  36.  
  37. var   standardlst : boolean;
  38.       reg         : registers;
  39.  
  40. function lstok  : boolean;
  41. begin
  42.   reg.ah := 2;
  43.   if standardlst
  44.     then reg.dx := 0
  45.     else reg.dx := 1;
  46.   intr($17,reg);
  47.   lstok := (reg.ah = lst_no_error)
  48. end;
  49.  
  50. function lst2ok : boolean;
  51. begin
  52.   reg.ah := 2;
  53.   if standardlst
  54.     then reg.dx := 1
  55.     else reg.dx := 0;
  56.   intr($17,reg);
  57.   lst2ok := (reg.ah = lst_no_error)
  58. end;
  59.  
  60. procedure initlst;
  61. begin
  62.   assign(lst,'lpt1');
  63.   rewrite(lst);
  64.   assign(lst2,'lpt2');
  65.   rewrite(lst2);
  66.   standardlst := true
  67. end;
  68.  
  69. procedure swaplst;
  70. begin
  71.   close(lst);
  72.   close(lst2);
  73.   if standardlst then
  74.     begin
  75.       assign(lst,'lpt2');
  76.       rewrite(lst);
  77.       assign(lst2,'lpt1');
  78.       rewrite(lst2);
  79.       standardlst := false
  80.     end
  81.     else initlst
  82. end;
  83.  
  84. function whichlst : shortint;
  85. var helpwhich : shortint;
  86. begin
  87.   helpwhich := 0;
  88.   if lstok  then inc(helpwhich,1);
  89.   if lst2ok then inc(helpwhich,2);
  90.   if standardlst
  91.     then whichlst :=  helpwhich
  92.     else whichlst := -helpwhich;
  93. end;
  94.  
  95. begin
  96.   initlst
  97. end.
  98.  
  99.