Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0356: Einen eigenen Drucker-Spooler einbinden

 von 

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 (): Nun sollte das Programm auch auf NT basierenden Systemen funktionieren.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

ClosePrinter, EnumJobsA (EnumJobs), OpenPrinterA (OpenPrinter), lstrcpyA (PtrToStr), SetJobA (SetJob), lstrlenA (StrLen)

Download:

Download des Beispielprojektes [4,67 KB]

'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-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

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