home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 03 / spool / spool.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1987-12-13  |  12.3 KB  |  241 lines
  1. UNIT Spool;             {  Print.Com Spool Utility                   }
  2. {                                                                    }
  3. {               SPOOL.PAS - Queue Management Routines                }
  4. {                                by                                  }
  5. {                          Duane L. Geiger                           }
  6. {                                                                    }
  7. INTERFACE               { Globally Known Types and Variables         }
  8.  
  9. Uses
  10.   DOS;                  { Standard TP4 DOS Unit                      }
  11.  
  12. TYPE
  13.   PathName  = STRING[64];         { Path and Filename String Area    }
  14.  
  15. VAR
  16.   OK        : Boolean;            { Global Flag for Success Tests    }
  17.   Error     : Byte;               { Error Flag if Not OK on Interrupt}
  18.  
  19. {  Possible error conditions encountered in Functions 1 through 5    }
  20. {  Carry Flag is Set and Register AX contains:                       }
  21. {              1 = Function Code Invalid                             }
  22. {              2 = File Not Found                                    }
  23. {              3 = Path Not Found                                    }
  24. {              4 = Too Many Open Files                               }
  25. {              5 = Access Denied                                     }
  26. {              8 = Queue is Full                                     }
  27. {              9 = Spooler Busy                                      }
  28. {            $0C = Name is too long                                  }
  29. {            $0F = Drive is invalid                                  }
  30.  
  31. FUNCTION  SpoolerInstalled  : Boolean;
  32. PROCEDURE SpoolerSubmit( Name : PathName );
  33. PROCEDURE SpoolerCancel( Name : PathName );
  34. PROCEDURE SpoolerCancelAll;
  35. PROCEDURE SpoolerStatusRead;
  36. PROCEDURE SpoolerStatusEnd;
  37.  
  38. FUNCTION  ShareInstalled    : Boolean;
  39.  
  40. IMPLEMENTATION
  41.  
  42. TYPE
  43.   ZName     = ARRAY[1..64] OF Byte;    { ASCIIZ FileName Area        }
  44.  
  45. VAR
  46.   Regs      : Registers;          { Registers for DOS Unit Interface }
  47.   Major,                          { Major Version of DOS Installed   }
  48.   Minor     : Word;               { Minor Version of DOS             }
  49.  
  50. PROCEDURE ASCIIZ( Name : PathName; VAR PassName : ZName );
  51. {  Create an ASCIIZ Name from Pascal String }
  52.   TYPE
  53.     ASCIIZName = RECORD                { Use the Structure of String }
  54.       LnByte : Byte;                   { Length of the String        }
  55.       NStr   : ZName;                  { Actual Characters in String }
  56.     END;
  57.  
  58.   VAR
  59.     Nme      : ASCIIZName ABSOLUTE Name;    { Point the the String   }
  60.  
  61.   BEGIN
  62.     Nme.NStr[Nme.LnByte+1] := $00;     { Null Terminate the String   }
  63.     PassName := Nme.Nstr;              { Return the ASCIIZ Portion   }
  64.   END;
  65.  
  66. FUNCTION SpoolerInstalled : Boolean;
  67. {  TRUE if Spooler Installed, Otherwise FALSE and an Error           }
  68. {       AL Contains installed Status:                                }
  69. {          $00 = Not Installed, OK to Install                        }
  70. {          $01 = Not Installed, Not OK to Install                    }
  71. {          $FF = Installed                                           }
  72.   BEGIN
  73.     {  First test to see if DOS Ver 3.00 or Greater is Running       }
  74.     IF (Major >= 3) AND           { It's version 3.0 or greater      }
  75.        (Minor >= 0) THEN          { Null then  (It's OK for $2F)     }
  76.     ELSE BEGIN                    { This is not a good version of DOS}
  77.       Error            := 1;      { Not Install and Can't Run        }
  78.       SpoolerInstalled := False;  { Function Return                  }
  79.       Exit;                       { Immeditate Exit                  }
  80.     END;                          { of Error Condition               }
  81.  
  82.     {  Now test to see if resident portion of Print.Com is installed.}
  83.     Error   := 0;                 { Reset System Wide Error          }
  84.     Regs.AH := $01;               { Select Resident Portion of Print }
  85.     Regs.AL := $00;               { Request the Installed Status     }
  86.     Intr($2F,Regs);               { Perform Status Interrupt         }
  87.     IF ((Regs.Flags AND FCarry) <> 0) THEN BEGIN  { Flags Set/Error  }
  88.       SpoolerInstalled := False;  { Set 'Not Installed' Switch       }
  89.       Error            := Regs.AX;{ Load the Error Encountered       }
  90.     END                           { of Error Condition               }
  91.     ELSE                          { The Interrupt Succeeded          }
  92.       SpoolerInstalled := (Regs.AL=$FF); { $FF Indicates Installed   }
  93.   END;
  94.  
  95. PROCEDURE SpoolerSubmit( Name : PathName );
  96.   TYPE
  97.     Packet = RECORD                    { Submit Packet for Print     }
  98.       Level : Byte;                    { Printer Level               }
  99.       NPtr  : Pointer;                 { Pointer to ASCIIZ Name      }
  100.     END;
  101.  
  102.   VAR
  103.     SubPack  : Packet;                 { Submit Filename Packet      }
  104.     PassName : Zname;                  { ASCIIZ FileName to Pass     }
  105.  
  106.   BEGIN
  107.     Error := 0;                        { Clear the Global Error Flag }
  108.     OK    := True;                     { Assume it will work         }
  109.     ASCIIZ( Name , PassName );         { Build an ASCIIZ Name to Pass}
  110.     SubPack.Level := 0;                { Print 'Level'               }
  111.     SubPack.NPtr  := @PassName;        { Pointer to Filename         }
  112.     Regs.AH       := $01;              { Resident Portion of Print   }
  113.     Regs.AL       := $01;              { Submit a File to Print      }
  114.     Regs.DS       := Seg(SubPack);     { Segment Pointer to Packet   }
  115.     Regs.DX       := Ofs(SubPack);     { Offset to SubMission        }
  116.     Intr($2F,Regs);                    { MultiPlex Interrupt         }
  117.     IF ((Regs.Flags AND FCarry) <> 0) THEN BEGIN   { Flags Set/Error }
  118.       OK    := False;                  { Error in File SubMission    }
  119.       Error := Regs.AX;                { Load the Error Variable     }
  120.     END;                               { of Error Handling           }
  121.   END;
  122.  
  123. PROCEDURE SpoolerCancel( Name : PathName );
  124. { Remove a Filename, Wildcards are allowed }
  125.   VAR
  126.     PassName : Zname;                  { ASCIIZ FileName to Pass     }
  127.  
  128.   BEGIN
  129.     Error := 0;                        { Clear the Global Error Flag }
  130.     OK    := True;                     { Assume if will work         }
  131.     ASCIIZ(Name,PassName);             { Build an ASCIIZ Name to Pass}
  132.     Regs.AH := $01;                    { Resident Portion of Print   }
  133.     Regs.AL := $02;                    { Cancel a File in Print Queue}
  134.     Regs.DS := Seg(PassName);          { Pointer to the ASCIIZ Name  }
  135.     Regs.DX := Ofs(PassName);          { Offset to ASCIIZ Name       }
  136.     Intr($2F,Regs);                    { Multiplex Interrupt         }
  137.     IF ((Regs.Flags AND FCarry) <> 0) THEN BEGIN   { Flags Set/Error }
  138.       OK    := False;                  { Error in File SubMission    }
  139.       Error := Regs.AX;                { Load the Error Variable     }
  140.     END;                               { of Error Handling           }
  141.   END;
  142.  
  143. PROCEDURE SpoolerCancelAll;
  144. {  Remove all names from print queue }
  145.   BEGIN
  146.     Error := 0;                        { Clear the Global Error Flag }
  147.     OK    := True;                     { Assume it will work         }
  148.     Regs.AH := $01;                    { Resident Portion of Print   }
  149.     Regs.AL := $03;                    { Cancel All Files In Queue   }
  150.     Intr($2F,Regs);                    { MultiPlex Interrupt         }
  151.     IF ((Regs.Flags AND FCarry) <> 0) THEN BEGIN { Flags Set if Error}
  152.       OK    := False;                  { Error in File SubMission    }
  153.       Error := Regs.AX;                { Load the Error Variable     }
  154.     END;                               { of Error Handling           }
  155.   END;
  156.  
  157. PROCEDURE SpoolerStatusRead;
  158. {  Pause the Spooler and Read the names  }
  159.   VAR
  160.     QPtr : ^ZName;                     { Pointer to ASCIIZ String    }
  161.     Idx  : LongInt ABSOLUTE QPtr;      { Index Pointer               }
  162.     I    : Byte;                       { String Index                }
  163.     Name : PathName;                   { Constructed File Name       }
  164.  
  165.   BEGIN
  166.     Error := 0;                        { Clear the Global Error Flag }
  167.     OK    := True;                     { Assume if will work         }
  168.     Regs.AH := $01;                    { Resident Portion of Print   }
  169.     Regs.AL := $04;                    { Hold for Status Read        }
  170.     Intr($2F,Regs);                    { MultiPlex Interrupt         }
  171.     IF ((Regs.Flags AND FCarry) <> 0) THEN BEGIN { Flags Set if Error}
  172.       OK    := False;                  { Error in File SubMission    }
  173.       Error := Regs.AX;                { Load the Error Variable     }
  174.     END                                { of Error Handling           }
  175.     ELSE BEGIN                         { Display the Queue           }
  176.  
  177.       { This section displays the names of all of the files that are }
  178.       { currently in the print Queue.  If you want control, modify   }
  179.       { this PROCEDURE to return the pointer to the names and bypass }
  180.       { this display routine.                                        }
  181.  
  182.       QPtr := Ptr( Regs.DS , Regs.SI );{ Point to First Name in Queue}
  183.       WHILE( QPtr^[1] <> $00 ) DO BEGIN  { Start a Display Loop      }
  184.         I := 1;   Name := '';          { Index Pointer               }
  185.         WHILE( QPtr^[I] <> $00 ) DO BEGIN   { Start displaying Names }
  186.           Name := Name + Chr( QPtr^[I] );{ Build the Name String     }
  187.           I := Succ(I);                { Point to Next Character     }
  188.         END;                           { of a Name Character         }
  189.         WriteLn(Name);                 { Display the Name just built }
  190.         Idx := Idx + 64;               { Point to Next 64 Bytes      }
  191.       END;                             { of Display Loop             }
  192.  
  193.     END;                               { of Queue Display            }
  194.   END;                                 { of SpoolerStatusRead        }
  195.  
  196. PROCEDURE SpoolerStatusEnd;
  197. {  Clear the Paused Condition }
  198.   BEGIN
  199.     Error := 0;                        { Clear the Global Error Flag }
  200.     OK    := True;                     { Assume if will work         }
  201.     Regs.AH := $01;                    { Resident Portion of Print   }
  202.     Regs.AL := $05;                    { Clear Status Read           }
  203.     Intr($2F,Regs);                    { MultiPlex Interrupt         }
  204.     IF ((Regs.Flags AND FCarry) <> 0) THEN BEGIN { Flags Set if Error}
  205.       OK    := False;                  { Error in File SubMission    }
  206.       Error := Regs.AX;                { Load the Error Variable     }
  207.     END;                               { of Error Handling           }
  208.   END;
  209.  
  210. FUNCTION ShareInstalled : Boolean;
  211.   BEGIN
  212.     {  First test to see if DOS Ver 3.00 or Greater is Running       }
  213.     IF (Major >= 3) AND           { It's version 3.0 or greater      }
  214.        (Minor >= 0) THEN          { Null then  (It's OK for $2F)     }
  215.     ELSE BEGIN                    { This is not a good version of DOS}
  216.       Error          := 1;        { Not Install and Can't Run        }
  217.       ShareInstalled := False;    { Function Return                  }
  218.       Exit;                       { Immeditate Exit                  }
  219.     END;                          { of Error Condition               }
  220.  
  221.     {  Now test to see if resident portion of Share is installed.    }
  222.     Error   := 0;                 { Reset System Wide Error          }
  223.     Regs.AH := $10;               { Select Resident Portion of Share }
  224.     Regs.AL := $00;               { Request the Installed Status     }
  225.     Intr($2F,Regs);               { Perform Status Interrupt         }
  226.     IF ((Regs.Flags AND FCarry) <> 0) THEN BEGIN { Flags Set if Error}
  227.       ShareInstalled := False;    { Set 'Not Installed' Switch       }
  228.       Error          := Regs.AX;  { Load the Error Encountered       }
  229.     END                           { of Error Condition               }
  230.     ELSE                          { The Interrupt Succeeded          }
  231.       ShareInstalled := (Regs.AL = $FF); { $FF Indicates Installed   }
  232.   END;
  233.  
  234. BEGIN
  235.   {  First test to see if DOS Ver 3.00 or Greater is Running         }
  236.   Regs.AH := $30;                 { Request Version Number           }
  237.   MsDos(Regs);                    { Perform Interrupt $21            }
  238.   Major   := Regs.AL;             { Extract Major Version of DOS     }
  239.   Minor   := Regs.AH;             { Extract Minor Version of DOS     }
  240. END.
  241.