VB 5/6-Tipp 0356: Einen eigenen Drucker-Spooler einbinden
von ActiveVB
Beschreibung
Hier wird versucht die Funktionalität des Spoolers nach zu bilden. Zum einen werden alle derzeitig im Puffer des Spoolers liegenden Jobs inklusive weiterer Informationen wie JobID, Auftragsdatum, Auftragsgeber, Auftragsrechner, Dokumentenname, Position in der Warteschlange ... angezeigt, des weiteren ist es möglich gezielt Jobs zu löschen, anzuhalten und wieder fortzusetzten. Letzteres bereitet wie beim "echten" Spooler bei größeren Druckercaches Probleme, da erstmal solange weitergedruckt wird, bis der Speicher des Druckers wieder leer ist.
Update von Florian Rittmeier (Florian@ActiveVB.de): Nun sollte das Programm auch auf NT basierenden Systemen funktionieren.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: ClosePrinter, EnumJobsA (EnumJobs), OpenPrinterA (OpenPrinter), lstrcpyA (PtrToStr), SetJobA (SetJob), lstrlenA (StrLen) | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektdatei Project1.vbp ------------- '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Schaltfläche "Command3" ' Steuerelement: Schaltfläche "Command2" (Index von 0 bis 2) ' Steuerelement: Listen-Steuerelement "List1" ' Steuerelement: Schaltfläche "Command1" Option Explicit Private Declare Function ClosePrinter Lib "winspool.drv" _ (ByVal hPrinter As Long) As Long Private Declare Function OpenPrinter Lib "winspool.drv" Alias _ "OpenPrinterA" (ByVal pPrinterName As String, phPrinter _ As Long, pDefault As PRINTER_DEFAULTS) As Long Private Declare Function EnumJobs Lib "winspool.drv" Alias _ "EnumJobsA" (ByVal hPrinter As Long, ByVal FirstJob _ As Long, ByVal NoJobs As Long, ByVal Level As Long, _ pJob As Long, ByVal cdBuf As Long, pcbNeeded As _ Long, pcReturned As Long) As Long Private Declare Function SetJob Lib "winspool.drv" Alias _ "SetJobA" (ByVal hPrinter As Long, ByVal JobId As Long, _ ByVal Level As Long, ByRef pJob As JOB_INFO_1, ByVal _ Command As Long) As Long Private Declare Function PtrToStr Lib "kernel32" Alias _ "lstrcpyA" (ByVal RetVal As String, ByVal Ptr As _ Long) As Long Private Declare Function StrLen Lib "kernel32" Alias _ "lstrlenA" (ByVal Ptr As Long) As Long Private Type SYSTEMTIME wYear As Integer wMonth As Integer wDayOfWeek As Integer wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type Private Type JOB_INFO_1 JobId As Long pPrinterName As String pMachineName As String pUserName As String pDocument As String pDatatype As String pStatus As String Status As Long Priority As Long Position As Long TotalPages As Long PagesPrinted As Long Submitted As SYSTEMTIME End Type Private Type PRINTER_DEFAULTS pDatatype As Long pDevMode As Long DesiredAccess As Long End Type Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000 Const PRINTER_ACCESS_ADMINISTER As Long = &H4& Const PRINTER_ACCESS_USE As Long = &H8& Const PRINTER_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or _ PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE) Const JOB_STATUS_PAUSED As Long = &H1& Const JOB_STATUS_ERROR As Long = &H2& Const JOB_STATUS_DELETING As Long = &H4& Const JOB_STATUS_SPOOLING As Long = &H8& Const JOB_STATUS_PRINTING As Long = &H10& Const JOB_STATUS_OFFLINE As Long = &H20& Const JOB_STATUS_PAPEROUT As Long = &H40& Const JOB_STATUS_PRINTED As Long = &H80& Const JOB_STATUS_USER_INTERVENTION As Long = &H10000 Const MAX_PRIORITY As Long = 99& Const MIN_PRIORITY As Long = 1& Const DEF_PRIORITY As Long = 1& Const JOB_CONTROL_PAUSE As Long = 1& Const JOB_CONTROL_RESUME As Long = 2& Const JOB_CONTROL_CANCEL As Long = 3& Const JOB_CONTROL_RESTART As Long = 4& Const JOB_CONTROL_DELETE As Long = 5& Private Const INFINITE As Long = &HFFFFFFFF Dim Job() As JOB_INFO_1 Private Sub Command1_Click() Call DisplaySpooler End Sub Private Sub Command2_Click(Index As Integer) Dim x As Long 'Anmerkung: In Netzwerken benötigen sie zur Ausführung der ' folgenden Aktionen die erforderlichen Rechte, ' andernfalls führen die Commandos zu keiner ' Reaktion. x = List1.ListIndex If x > -1 Then Select Case Index Case 0: Call JobCmd(x, JOB_CONTROL_CANCEL) Case 1: Call JobCmd(x, JOB_CONTROL_PAUSE) Case 2: Call JobCmd(x, JOB_CONTROL_RESUME) End Select End If End Sub Private Sub DisplaySpooler() Dim Result As Long, Required As Long, BufLen As Long Dim Buffer() As Long, Entries As Long Dim hPrinter As Long, l As Long, x As Long Dim LiMem As Integer Dim PName As String, aa As String Dim pd As PRINTER_DEFAULTS Const c& = 16 ' Damit das ganze auch auf NT-basierenden Systemen funktioniert pd.DesiredAccess = PRINTER_ALL_ACCESS BufLen = 4 ReDim Buffer(0) LiMem = List1.ListIndex List1.Clear 'Standarddruckername erfahren PName = Printer.DeviceName 'Drucker öffnen Result = OpenPrinter(PName, hPrinter, pd) If Result <> 0 Then 'Alles bisher gut gelaufen, jetzt mal abklopfen wieviel 'Platz wir brauchen Result = EnumJobs(hPrinter, 0, INFINITE, 1, Buffer(0), _ BufLen, Required, Entries) If Result <> 0 And Required = 0 Then 'Keine Jobs in der Warteschlange 'Printerhandle wieder schließen Call ClosePrinter(hPrinter) Exit Sub ElseIf Result = 0 And Required > 0 Then 'Ist der Puffer groß genug? BufLen = Required ReDim Buffer((BufLen / 4) - 1) Result = EnumJobs(hPrinter, 0, INFINITE, 1, Buffer(0), _ BufLen, Required, Entries) If Result = 0 Then 'Fehler Call MsgBox("Beim Ermitteln der Jobs ist ein Fehler " & _ "aufgetreten.", vbExclamation + vbOKOnly, App.Title) 'Printerhandle wieder schließen Call ClosePrinter(hPrinter) Exit Sub End If Else 'Fehler Call MsgBox("Beim Ermitteln der Jobs ist ein Fehler " & _ "aufgetreten.", vbExclamation + vbOKOnly, App.Title) 'Printerhandle wieder schließen Call ClosePrinter(hPrinter) Exit Sub End If 'Printerhandle wieder schließen Call ClosePrinter(hPrinter) ReDim Job(0 To Entries - 1) For x = 0 To Entries - 1 'JobID: Buffer(0) Job(x).JobId = Buffer(c * x + 0) 'Druckername: Buffer(1) aa = Space$(StrLen(Buffer(c * x + 1)) + 1) Call PtrToStr(aa, Buffer(c * x + 1)) aa = Left$(aa, InStr(aa, Chr$(0)) - 1) Job(x).pPrinterName = aa 'Rechnername: Buffer(2), gleiches Spiel wie oben aa = Space$(StrLen(Buffer(c * x + 2)) + 1) Call PtrToStr(aa, Buffer(c * x + 2)) aa = Trim$(Left$(aa, InStr(aa, Chr$(0)) - 1)) Job(x).pMachineName = aa 'Username: Buffer(3), gleiches Spiel wie oben aa = Space$(StrLen(Buffer(c * x + 3)) + 1) Call PtrToStr(aa, Buffer(c * x + 3)) aa = Left$(aa, InStr(aa, Chr$(0)) - 1) Job(x).pUserName = aa 'Dokumentenname aa = Space$(StrLen(Buffer(c * x + 4)) + 1) Call PtrToStr(aa, Buffer(c * x + 4)) aa = Left$(aa, InStr(aa, Chr$(0)) - 1) Job(x).pDocument = aa 'Datentyp aa = Space$(StrLen(Buffer(c * x + 5)) + 1) Call PtrToStr(aa, Buffer(c * x + 5)) aa = Left$(aa, InStr(aa, Chr$(0)) - 1) Job(x).pDatatype = aa 'Jobstatus: Ist dieser Wert gleich nix, dann ist der Status 'über den folgenden Parameter (Buffer(7)) näher definiert aa = Space$(StrLen(Buffer(c * x + 6)) + 1) Call PtrToStr(aa, Buffer(c * x + 6)) If InStr(aa, Chr$(0)) <> 0 Then aa = Left$(aa, InStr(aa, Chr$(0)) - 1) Else aa = "" End If Job(x).pStatus = aa 'Status-Flags Job(x).Status = Buffer(c * x + 7) 'Buffer(8) Spezifiziert die Dringlichkeit. Job(x).Priority = Buffer(c * x + 8) 'Zeigt die Position des Jobs in der Queue an Job(x).Position = Buffer(c * x + 9) 'Erzählt uns wieviel Seiten es ingesamt sind Job(x).TotalPages = Buffer(c * x + 10) 'Erzählt uns wieviel Seiten davon schon gedruckt wurden Job(x).PagesPrinted = Buffer(c * x + 11) 'Submitted With Job(x).Submitted .wYear = Buffer(c * x + 12) Mod 65536 .wMonth = Buffer(c * x + 12) \ 65536 .wDayOfWeek = Buffer(c * x + 13) Mod 65536 .wDay = Buffer(c * x + 13) \ 65536 .wHour = Buffer(c * x + 14) Mod 65536 .wMinute = Buffer(c * x + 14) \ 65536 .wSecond = Buffer(c * x + 15) Mod 65536 .wMilliseconds = Buffer(c * x + 15) \ 65536 End With Next x 'Ausgabe For x = 0 To UBound(Job) List1.AddItem ConvJobToString(Job(x)) Next x If List1.ListCount > 0 Then If LiMem >= List1.ListCount = -1 Or LiMem = -1 Then LiMem = 0 End If List1.ListIndex = LiMem End If End If End Sub Private Function ConvJobToString(jb As JOB_INFO_1) As String Dim aa As String, Stat As String With jb Stat = PStatusToString(.Status) aa = CStr(.JobId) & " - " aa = aa & .pPrinterName & " - " aa = aa & .pMachineName & " - " aa = aa & .pUserName & " - " aa = aa & .pDocument & " - " aa = aa & .pDatatype & " - " aa = aa & .pStatus & " [" & Stat & "] - " aa = aa & .Position & " [" & .Priority & "] - " aa = aa & .PagesPrinted & " [" & .TotalPages & "] - " aa = aa & .Submitted.wDay & "." & .Submitted.wMonth & "." & _ .Submitted.wYear & " " & .Submitted.wHour & ":" & _ .Submitted.wMinute & ":" & .Submitted.wSecond End With ConvJobToString = aa End Function Private Sub JobCmd(JobIndex As Long, Cmd As Long) Dim Result As Long, hPrinter As Long Dim PName As String Dim pd As PRINTER_DEFAULTS ' Damit das ganze auch auf NT-basierenden Systemen funktioniert pd.DesiredAccess = PRINTER_ACCESS_ADMINISTER 'Standarddruckername erfahren PName = Printer.DeviceName 'Drucker öffnen Result = OpenPrinter(PName, hPrinter, pd) If Result <> 0 Then Result = SetJob(hPrinter, Job(JobIndex).JobId, 1&, Job(JobIndex), _ Cmd) If Result = 0 Then Call MsgBox("Die Operation konnte nicht erfolgreich " & _ "ausgeführt werden.", vbExclamation + vbOKOnly, App.Title) End If Call ClosePrinter(hPrinter) Else Call MsgBox("Der Zugriff auf den Drucker wurde verweigert.", _ vbExclamation + vbOKOnly, App.Title) End If Call DisplaySpooler End Sub Private Function PStatusToString(Flag As Long) As String Dim aa As String If Flag And JOB_STATUS_PAUSED Then aa = "PAUSE " If Flag And JOB_STATUS_ERROR Then aa = aa & "ERROR " If Flag And JOB_STATUS_DELETING Then aa = aa & "DELETING " If Flag And JOB_STATUS_SPOOLING Then aa = aa & "SPOOLING " If Flag And JOB_STATUS_PRINTING Then aa = aa & "PRINTING " If Flag And JOB_STATUS_OFFLINE Then aa = aa & "OFFLINE " If Flag And JOB_STATUS_PAPEROUT Then aa = aa & "PAPEROUT " If Flag And JOB_STATUS_USER_INTERVENTION Then aa = aa & "INTERVENTION" PStatusToString = Trim$(aa) End Function Private Sub Command3_Click() Printer.Print "Testjob für den Druckerspooler von ActiveVB.de" Printer.EndDoc DoEvents Call DisplaySpooler End Sub '---------- Ende Formular "Form1" alias Form1.frm ---------- '-------------- Ende Projektdatei Project1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 7 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von silke am 01.02.2008 um 01:43
ich versuche schon über wochen meinen pc wieder fit zu kriegen. wenn ich meinen drucker installieren möchte, komme ich nur bis *spooler - service* angehalten, wieder starten .... und dann tut sich nichts mehr. nun versuch ich mich zu belesen um vielleicht eine lösung zu finden.
können sie mir ein stück weiter helfen?
Kommentar von DNAcid am 31.03.2006 um 01:38
ich nutze einen drucker über eine netzwerkverbindung unter WinXP und konnte die druckauträge nicht anhalten oder starten, doch mit einer kleinen änderung funktioniert es:
Result = SetJob(hPrinter, Job(JobIndex).JobId, 0, Job(JobIndex), Cmd)
vorher stand anstelle der "0" eine "1&"
Kommentar von Thomas am 18.01.2004 um 18:30
Das ganze scheint mit Netzwerkdruckern nicht zu funktionieren. Gibt es da irgendwelche Möglichkeiten?
Kommentar von Thomas Tölg am 26.12.2003 um 14:43
hallo andreas, ich hätte interesse am korrigierten source.
bitte per mail an toelg_th@bulme.at
danke :)
lg
Thomas
Kommentar von Stephan Hollaus am 02.10.2002 um 17:33
Woher bekomme ich genauere Informationen zur API - Funktion SetJob?
Ich öchte die Priorität ändern und weiss nicht wie.
Kann mir wer helfen?
mfg Stephan
Kommentar von Andreas Heil am 18.06.2002 um 12:48
Dies war der einzige brauchbare Source, den ich im www zum Thema Spooler in VB gefunden habe. Leider hat er in der vorliegenden Fassung einige kleinere Mängel, die zu bösen Fehlern führen. Da mir der Tip aber trotzdem sehr weitergeholfen hat, stelle ich gerne allen Interessierten per Mail einen korrigierten und erweiterten Code mit Datagrid statt Listbox zur Verfügung (Läuft bei mir unter NT4-Server SP6).
Kommentar von Marc Stoffel am 07.05.2001 um 15:12
Hallo, ich habe den Spooler in mein Projekt indem ich Druckaufträge erfasse und verrechne eingebaut. Nun mein Problem, ab und zu werden Dokumentname oder Seitanzahl nicht richtig angegeben, die Seitenanzahl ist dann immer = 0. Was könnte das sein?
Vielen Dank! sonst ist der Code super
Marc