vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
NEU! sevCoolbar 3.0 - Professionelle Toolbars im modernen Design!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Drucker   |   VB-Versionen: VB5, VB624.03.05
Druckerstatus auslesen

Unter Zuhilfenahme des "Active Directory Service" lässt sich der Druckerstatus bequem auslesen.

Autor:   Dietmar G. BayerBewertung:     [ Jetzt bewerten ]Views:  28.351 
ohne HomepageSystem:  WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Unter Zuhilfenahme des "Active Directory Service" lässt sich der Druckerstatus bequem und einfach auslesen (z.B. Pause, Löscht, Druckt, etc.).

Erstellen Sie ein neues Projekt und markieren zunächst den Eintrag Active DS Type Library im Dialog "Verweise". Platzieren Sie anschließend ein ListView-Control auf die Form und darunter einen CommandButton. Beim Klick auf den CommandButton soll der Druckerstatus aller installierten Drucker ermittelt und im ListView-Control angezeigt werden.

Option Explicit
 
' Benötigte API-Deklaratione
Private Declare Function GetComputerName Lib "kernel32" _
  Alias "GetComputerNameA" ( _
  ByVal lpBuffer As String, _
  nSize As Long) As Long
 
' Druckerstatus
Const ADS_JOB_PAUSED = &H1
Const ADS_JOB_ERROR = &H2
Const ADS_JOB_DELETING = &H4
Const ADS_JOB_PRINTING = &H10
Const ADS_JOB_OFFLINE = &H20
Const ADS_JOB_PAPEROUT = &H40
Const ADS_JOB_PRINTED = &H80
Const ADS_JOB_DELETED = &H100
Private Sub Form_Load()
  Dim i As Long
 
  ' ListView-Spalten erstellen
  With ListView1.ColumnHeaders
    .Add, , "Printer", 3600
    .Add , , "Status", 1800
  End With
 
  ' auf Detailansicht umschalten
  ListView1.View = lvwReport
 
  ' alle Drucker auflisten
  For i = 0 To Printers.Count - 1
    ListView1.ListItems.Add , , Printers(i).DeviceName
  Next i
End Sub
' Druckerstatus aller im ListView aufgeführten 
' Drucker ermitteln
Private Sub Command1_Click()
  Dim sPrinter As String
  Dim sComputer As String
  Dim sPrinterName As String
  Dim sSearch As String
  Dim pq As IADsPrintQueue
  Dim pqo As IADsPrintQueueOperations
  Dim i As Long
 
  On Error GoTo ErrHandler
  Screen.MousePointer = 11
  With ListView1
    For i = 1 To .ListItems.Count
      With .ListItems(i)
        sPrinter = .Text
        If InStr(sPrinter, "auf") > 0 Then
          sComputer = Trim$(Mid$(sPrinter, InStr(sPrinter, "auf") + 4))
          sPrinterName = Trim$(Left$(sPrinterName, InStr(sPrinterName, "auf") - 1))
          If InStr(sPrinterName, "/") Then
            sPrinterName = ""
           ' das ist wegen "Automatisch Generic / Text Only auf KUBUS"
           ' Am besten umbenennen
          End If
        Else
          sPrinterName = sPrinter
          sComputer = GetComputerInfo
          ' hier was blödes
          If InStr(sPrinterName, "/") Then
            sPrinterName = ""
            ' das ist wegen "Automatisch Generic / Text Only auf KUBUS"
            ' Am besten umbenennen
          End If
        End If
 
        If Len(sPrinterName) > 0 Then
          sSearch = "WinNT://" + sComputer + "/" + sPrinterName
          Set pq = GetObject(sSearch)
          Set pqo = pq
          Select Case pqo.Status
            Case ADS_JOB_PAUSED
              .SubItems(1) = "Pause"
            Case ADS_JOB_ERROR
              .SubItems(1) = "Error"
            Case ADS_JOB_DELETING
              .SubItems(1) = "Löscht"
            Case ADS_JOB_PRINTING
              .SubItems(1) = "Druckt"
            Case ADS_JOB_OFFLINE
              .SubItems(1) = "ist Offline"
            Case ADS_JOB_PAPEROUT
              .SubItems(1) = "Papier fehlt"
            Case ADS_JOB_PRINTED
              .SubItems(1) = "Drucken fertig"
            Case ADS_JOB_DELETED
              .SubItems(1) = "Löschen fertig"
            Case Else
              .SubItems(1) = "wartet"
          End Select
        End If
      End With
    Next i
  End With
  Screen.MousePointer = 0
  Exit Sub
 
ErrHandler:
  ListView1.ListItems(i).SubItems(1) = "Fehler"
  Set pq = Nothing
  Set pqo = Nothing
  Resume Next
End Sub
' Die Funktion ermittelt den Computer-Namen
Public Function GetComputerInfo() As String
  Dim nResult As Long
  Dim sBuffer As String
 
  sBuffer = Space$(256)
  nResult = GetComputerName(sBuffer, Len(sBuffer))
  If InStr(sBuffer, Chr$(0)) > 0 Then _
    sBuffer = Left$(sBuffer, InStr(sBuffer, Chr$(0)) - 1)
 
  GetComputerInfo = sBuffer
End Function

Dieser Tipp wurde bereits 28.351 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (1 Beitrag)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel