home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TSPOOL.ZIP / TSPOOL.PAS
Encoding:
Pascal/Delphi Source File  |  1986-09-17  |  5.4 KB  |  176 lines
  1.  
  2. {            TURBO PASCAL LIBRARY                }
  3. {                  SPOOL.PAS                     }
  4. {           Background Print Spooler             }
  5. {               for the IBM PC                   }
  6. {Copyright (c) 1986 Patrick J. Finan             }
  7. {Modified for Turbo Pascal                       }
  8. {                    by Rob Murdock              }
  9.  
  10. CONST
  11.    ERROR_MASK = $0001;
  12.  
  13. TYPE
  14.  REGLIST      = RECORD
  15.                 AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS: INTEGER
  16.                 END;
  17.  
  18.  SUBMITPACKET = RECORD
  19.                 LEVEL_CODE     : BYTE;
  20.                 FILE_OFFSET,
  21.                 FILE_SEGMENT   : INTEGER;
  22.                 END;
  23.  
  24.    ASCIIZ     = STRING[64];
  25.    BLOCK      = ARRAY[1..2048] OF CHAR;
  26.  
  27. VAR    REGS:    REGLIST;
  28.  RETCODE, I:    INTEGER;
  29. MAJOR,MINOR:    BYTE;
  30.      BLOCK1:    BLOCK;
  31.     FILESTR:    ASCIIZ;
  32.  
  33.  
  34. PROCEDURE GET_DOS_VERSION(VAR MAJOR   : BYTE;
  35.                           VAR MINOR   : BYTE;
  36.                           VAR RETCODE : INTEGER);
  37.  
  38. { MAJOR = 3 and MINOR = 10 when running under    }
  39. { DOS 3.10.                                      }
  40. {                                                }
  41. { The values for RETCODE are as follows:         }
  42. {   0 - DOS version in MAJOR and MINOR.          }
  43. {  >0 - Error encountered... MAJOR AND MINOR may }
  44. {       not be valid.                            }
  45.  
  46. VAR
  47.    REGISTER    : REGLIST;
  48.  
  49. BEGIN {GET_DOS_VERSION}
  50.    REGISTER.AX := $3000;
  51.    INTR($21,REGISTER);
  52.    IF (REGISTER.FLAGS AND ERROR_MASK) = ERROR_MASK
  53.       THEN RETCODE := ORD(REGISTER.AX)
  54.       ELSE RETCODE := 0;
  55.    MAJOR := LO(REGISTER.AX) ;
  56.    MINOR := HI(REGISTER.AX) ;
  57. END; {GET_DOS_VERSION}
  58.  
  59. PROCEDURE GET_SPOOL_STATUS(VAR RETCODE : INTEGER);
  60.  
  61. { The values returned in RETCODE are as follows: }
  62. {  -3 - Error in status request.                 }
  63. {  -2 - Spooler not available.                   }
  64. {  -1 - Spooler not installed.                   }
  65. {   0 - Spooler installed and available.         }
  66. {  >0 - DOS error code.                          }
  67.  
  68. VAR
  69.    REGISTER    : REGLIST;
  70.  
  71. BEGIN {GET_SPOOL_STATUS}
  72.    REGISTER.AX := $0100;
  73.    INTR($2F,REGISTER);
  74.    IF (REGISTER.FLAGS AND ERROR_MASK) = ERROR_MASK
  75.       THEN RETCODE := ORD(REGISTER.AX)
  76.       ELSE CASE (REGISTER.AX AND $00FF) OF
  77.               0: RETCODE := -1;
  78.               1: RETCODE := -2;
  79.             255: RETCODE :=  0;
  80.             ELSE RETCODE := -3;
  81.                  END;
  82. END; {GET_SPOOL_STATUS}
  83.  
  84. PROCEDURE SUBMIT_TO_SPOOL(VAR FILENAME : ASCIIZ;
  85.                           VAR RETCODE  : INTEGER);
  86.  
  87. { FILENAME := 'd:\path\path\filename.ext'        }
  88. {                                                }
  89. { The values for RETCODE are as follows:         }
  90. {   0 - File successfully submitted.             }
  91. {  >0 - DOS error code.                          }
  92.  
  93. VAR
  94.    PACKET   : SubmitPacket;
  95.    REGISTER : REGLIST;
  96.  
  97. BEGIN {SUBMIT_TO_SPOOL}
  98.    FILENAME := CONCAT(FILENAME,CHR(0));
  99.    PACKET.LEVEL_CODE   := $00;
  100.    PACKET.FILE_SEGMENT := Seg(FileName) ;
  101.    PACKET.FILE_OFFSET  := Ofs(FileName) + 1 ;
  102.    REGISTER.AX  := $0101;
  103.    REGISTER.DS  := Seg(Packet) ;
  104.    REGISTER.DX  := Ofs(Packet) ;
  105.    INTR($2F,REGISTER);
  106.    IF (REGISTER.FLAGS AND ERROR_MASK) = ERROR_MASK
  107.       THEN RETCODE := ORD(REGISTER.AX)
  108.       ELSE RETCODE := 0;
  109. END; {SUBMIT_TO_SPOOL}
  110.  
  111. PROCEDURE DELETE_FROM_SPOOL(VAR FILENAME : ASCIIZ;
  112.                             VAR RETCODE  : INTEGER);
  113.  
  114. { FILENAME := 'd:\path\path\filename.ext'        }
  115. { The wildcard characters * and ? are valid.     }
  116. {                                                }
  117. { The values for RETCODE are as follows:         }
  118. {   0 - file successfully deleted.               }
  119. {  >0 - DOS error code.                          }
  120.  
  121. VAR
  122.    REGISTER : REGLIST;
  123.  
  124. BEGIN {DELETE_FROM_SPOOL}
  125.    FILENAME := CONCAT(FILENAME,CHR(0));
  126.    REGISTER.AX := $0102;
  127.    REGISTER.DS := Seg(FILENAME) ;
  128.    REGISTER.DX := Ofs(FILENAME) + 1 ;
  129.    INTR($2F,REGISTER);
  130.    IF (REGISTER.FLAGS AND ERROR_MASK) = ERROR_MASK
  131.       THEN RETCODE := ORD(REGISTER.AX)
  132.       ELSE RETCODE := 0;
  133. END; {DELETE_FROM_SPOOL}
  134.  
  135. PROCEDURE CLEAR_SPOOL(VAR RETCODE : INTEGER);
  136.  
  137. { The values for RETCODE are as follows:         }
  138. {   0 - spool cleared.                           }
  139. {  >0 - DOS error code.                          }
  140.  
  141. VAR
  142.    REGISTER : REGLIST;
  143.  
  144. BEGIN {CLEAR_SPOOL}
  145.    REGISTER.AX := $0103;
  146.    INTR($2F,REGISTER);
  147.    IF (REGISTER.FLAGS AND ERROR_MASK) = ERROR_MASK
  148.       THEN RETCODE := ORD(REGISTER.AX)
  149.       ELSE RETCODE := 0;
  150. END; {CLEAR_SPOOL}
  151.  
  152. PROCEDURE GET_SPOOL_QUE(VAR QUE_BUFFER : BLOCK;
  153.                         VAR RETCODE    : INTEGER);
  154.  
  155. { This routine will return the current DOS print }
  156. { queue in QUE_BUFFER.                           }
  157. {                                                }
  158. { The values for RETCODE are as follows:         }
  159. {   0 - request was successful.                  }
  160. {  >0 - DOS error code.                          }
  161.  
  162. VAR
  163.    REGISTER        : REGLIST;
  164.  
  165. BEGIN {GET_SPOOL_QUE}
  166.    REGISTER.AX := $0104;
  167.    INTR($2F,REGISTER);
  168.    IF (REGISTER.FLAGS AND ERROR_MASK) = ERROR_MASK
  169.       THEN RETCODE := ORD(REGISTER.AX)
  170.       ELSE RETCODE := 0;
  171.    MOVE (MEM[REGISTER.DS:REGISTER.SI], QUE_BUFFER, 2048);
  172.    REGISTER.AX := $0105;
  173.    INTR($2F,REGISTER);
  174. END; {GET_SPOOL_QUE}
  175. 
  176.