Untitled

Infos über Drucker auslesen

Um Informationen über installierte Drucker und deren Einstellungen geliefert zu bekommen, kann man sich der API-Funktion EnumPrinters bedienen. Diese kann übergebene Strukturen mit den gewünschten Informationen füllen.

In diesem Beispiel wird die Struktur PRINTER_INFO_2 ausgefüllt. Diese wiederum enthält einen Zeiger auf Daten, die als Struktur DEVMODE irgendwo im Speicher liegt und auch ausgewertet wird.

EnumPrinters liefert Daten über alle installierten Drucker, die dann nacheinander ausgelesen werden und in einem Array des von mir angelegten benutzerdefinierten Typs Printerinfos in lesbarer Form gespeichert werden.

Weiterhin kann man mit der API DeviceCapabilities alle möglichen Informationen geliefert bekommen, die von einem Drucker unterstützt werden. Ich lese hier aber lediglich die Information DC_PAPERNAMES aus, die aus einem Array mit 64 Bit langen Zeichenketten besteht.

Die gesamte Info liegt als ein einziger String vor und muss erst so zurechtgestutzt werden, dass daraus ein String entsteht, bei dem jeder unterstützte Blattyp in eine eigene Zeile kommt. Benötigt man statt dessen ein Array, kann man die Funktion Split benutzen, wobei man als Trennzeichen vbCrLf verwendet.

Hier der Code, der im Klickereignis des Buttons ausgeführt wird und der die Infos in das Tabellenblatt einträgt:

Private Sub cmbInfo_Click()
Dim varDummy   As Variant
Dim i          As Long
   DruckerListe
   Me.Range("B1:Z25").ClearContents
   For i = 2 To UBound(audtDruckerinfo) + 1
      With audtDruckerinfo(i - 1)
         Me.Cells(3, i) = .AveragePPM
         Me.Cells(4, i) = .Color
         Me.Cells(5, i) = .Comment
         Me.Cells(6, i) = .Datatype
         Me.Cells(7, i) = .DefaultPriority
         Me.Cells(14, i) = .DeviceName
         Me.Cells(15, i) = .DriverName
         Me.Cells(8, i) = .Jobs
         Me.Cells(9, i) = .Location
         Me.Cells(10, i) = .Orientation
         Me.Cells(11, i) = Replace(.Papernames, vbCrLf, vbLf)
         Me.Cells(12, i) = .PaperSize
         Me.Cells(13, i) = .Parameters
         Me.Cells(2, i) = .PortName
         Me.Cells(1, i) = .PrinterName
         Me.Cells(16, i) = .PrintProcessor
         Me.Cells(17, i) = .PrintQuality
         Me.Cells(18, i) = .Priority
         Me.Cells(19, i) = .SepFile
         Me.Cells(20, i) = .ServerName
         Me.Cells(21, i) = .ShareName
         Me.Cells(22, i) = .StartTime
         Me.Cells(23, i) = .Status
         Me.Cells(24, i) = .UntilTime
         Me.Cells(25, i) = .YResolution
      End With
   Next
End Sub

Hier der Code, der die Arbeit erledigt. Der größte Teil besteht aus der Typendefinition und Deklaration von API-Funktionen und der zugehörigen Konstanten. Also nicht gleich zurückschrecken, der eigentliche Code ist gar nicht so kompliziert!

Option Explicit
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32

Private Type ACL
   AclRevision As Byte
   Sbz1 As Byte
   AclSize As Integer
   AceCount As Integer
   Sbz2 As Integer
End Type

Private Type SECURITY_DESCRIPTOR
   Revision As Byte
   Sbz1 As Byte
   Control As Long
   Owner As Long
   Group As Long
   Sacl As ACL
   Dacl As ACL
End Type

Private Type DEVMODE
   dmDeviceName As String * CCHDEVICENAME
   dmSpecVersion As Integer
   dmDriverVersion As Integer
   dmSize As Integer
   dmDriverExtra As Integer
   dmFields As Long
   dmOrientation As Integer
   dmPaperSize As Integer
   dmPaperLength As Integer
   dmPaperWidth As Integer
   dmScale As Integer
   dmCopies As Integer
   dmDefaultSource As Integer
   dmPrintQuality As Integer
   dmColor As Integer
   dmDuplex As Integer
   dmYResolution As Integer
   dmTTOption As Integer
   dmCollate As Integer
   dmFormName As String * CCHFORMNAME
   dmUnusedPadding As Integer
   dmBitsPerPel As Long
   dmPelsWidth As Long
   dmPelsHeight As Long
   dmDisplayFlags As Long
   dmDisplayFrequency As Long
End Type

Private Type PRINTER_INFO_2
   pServerName As String
   pPrinterName As String
   pShareName As String
   pPortName As String
   pDriverName As String
   pComment As String
   pLocation As String
   pDevMode As Long 'DEVMODE
   pSepFile As String
   pPrintProcessor As String
   pDatatype As String
   pParameters As String
   pSecurityDescriptor As Long 'SECURITY_DESCRIPTOR
   Attributes As Long
   Priority As Long
   DefaultPriority As Long
   StartTime As Long
   UntilTime As Long
   Status As Long
   cJobs As Long
   AveragePPM As Long
End Type

Public Type Printerinfos
   ServerName        As String
   PrinterName       As String
   ShareName         As String
   PortName          As String
   DriverName        As String
   Comment           As String
   Location          As String
   SepFile           As String
   PrintProcessor    As String
   Datatype          As String
   Parameters        As String
   Priority          As Long
   DefaultPriority   As Long
   StartTime         As Long
   UntilTime         As Long
   Status            As Long
   Jobs              As Long
   AveragePPM        As Long
   DeviceName        As String
   Orientation       As String
   PaperSize         As String
   Papernames        As String
   PrintQuality      As String
   Color             As String
   YResolution       As String
End Type

Private Type PRINTER_DEFAULTS
   pDatatype As String
   pDevMode As DEVMODE
   DesiredAccess As Long
End Type

Private Const PRINTER_ENUM_LOCAL = &H2
Private Const PRINTER_ENUM_NETWORK = &H40 'Nur NT und Level1
Private Const PRINTER_ENUM_CONNECTIONS = &H4 'Nur NT
Private Const PRINTER_ENUM_DEFAULT = &H1
Private Const PRINTER_ENUM_REMOTE = &H10 'Nur NT und Level1
Private Const PRINTER_ENUM_SHARED = &H20 'Nur kombiniert mit anderen Konstanten

' Papierformate
Private Const DMPAPER_LETTER = 1
Private Const DMPAPER_LETTERSMALL = 2
Private Const DMPAPER_TABLOID = 3
Private Const DMPAPER_LEDGER = 4
Private Const DMPAPER_LEGAL = 5
Private Const DMPAPER_STATEMENT = 6
Private Const DMPAPER_EXECUTIVE = 7
Private Const DMPAPER_A3 = 8
Private Const DMPAPER_A4 = 9
Private Const DMPAPER_A4SMALL = 10
Private Const DMPAPER_A5 = 11
Private Const DMPAPER_B4 = 12
Private Const DMPAPER_B5 = 13
Private Const DMPAPER_FOLIO = 14
Private Const DMPAPER_QUARTO = 15
Private Const DMPAPER_10x14 = 16
Private Const DMPAPER_11X17 = 17
Private Const DMPAPER_NOTE = 18
Private Const DMPAPER_ENV_9 = 19
Private Const DMPAPER_ENV_10 = 20
Private Const DMPAPER_ENV_11 = 21
Private Const DMPAPER_ENV_12 = 22
Private Const DMPAPER_ENV_14 = 23
Private Const DMPAPER_CSHEET = 24
Private Const DMPAPER_DSHEET = 25
Private Const DMPAPER_ESHEET = 26
Private Const DMPAPER_ENV_DL = 27
Private Const DMPAPER_ENV_C5 = 28
Private Const DMPAPER_ENV_C3 = 29
Private Const DMPAPER_ENV_C4 = 30
Private Const DMPAPER_ENV_C6 = 31
Private Const DMPAPER_ENV_C65 = 32
Private Const DMPAPER_ENV_B4 = 33
Private Const DMPAPER_ENV_B5 = 34
Private Const DMPAPER_ENV_B6 = 35
Private Const DMPAPER_ENV_ITALY = 36
Private Const DMPAPER_ENV_MONARCH = 37
Private Const DMPAPER_ENV_PERSONAL = 38
Private Const DMPAPER_FANFOLD_US = 39
Private Const DMPAPER_FANFOLD_STD_GERMAN = 40
Private Const DMPAPER_FANFOLD_LGL_GERMAN = 41
Private Const DMPAPER_ISO_B4 = 42
Private Const DMPAPER_JAPANESE_POSTCARD = 43
Private Const DMPAPER_9X11 = 44
Private Const DMPAPER_10X11 = 45
Private Const DMPAPER_15X11 = 46
Private Const DMPAPER_ENV_INVITE = 47
Private Const DMPAPER_LETTER_EXTRA = 50
Private Const DMPAPER_LEGAL_EXTRA = 51
Private Const DMPAPER_TABLOID_EXTRA = 52
Private Const DMPAPER_A4_EXTRA = 53
Private Const DMPAPER_LETTER_TRANSVERSE = 54
Private Const DMPAPER_A4_TRANSVERSE = 55
Private Const DMPAPER_LETTER_EXTRA_TRANSVERSE = 56
Private Const DMPAPER_A_PLUS = 57
Private Const DMPAPER_B_PLUS = 58
Private Const DMPAPER_LETTER_PLUS = 59
Private Const DMPAPER_A4_PLUS = 60
Private Const DMPAPER_A5_TRANSVERSE = 61
Private Const DMPAPER_B5_TRANSVERSE = 62
Private Const DMPAPER_A3_EXTRA = 63
Private Const DMPAPER_A5_EXTRA = 64
Private Const DMPAPER_B5_EXTRA = 65
Private Const DMPAPER_A2 = 66
Private Const DMPAPER_A3_TRANSVERSE = 67
Private Const DMPAPER_A3_EXTRA_TRANSVERSE = 68
Private Const DMPAPER_DBL_JAPANESE_POSTCARD = 69
Private Const DMPAPER_A6 = 70
Private Const DMPAPER_JENV_KAKU2 = 71
Private Const DMPAPER_JENV_KAKU3 = 72
Private Const DMPAPER_JENV_CHOU3 = 73
Private Const DMPAPER_JENV_CHOU4 = 74
Private Const DMPAPER_LETTER_ROTATED = 75
Private Const DMPAPER_A3_ROTATED = 76
Private Const DMPAPER_A4_ROTATED = 77
Private Const DMPAPER_A5_ROTATED = 78
Private Const DMPAPER_B4_JIS_ROTATED = 79
Private Const DMPAPER_B5_JIS_ROTATED = 80
Private Const DMPAPER_JAPANESE_POSTCARD_ROTATED = 81
Private Const DMPAPER_DBL_JAPANESE_POSTCARD_ROTATED = 82
Private Const DMPAPER_A6_ROTATED = 83
Private Const DMPAPER_JENV_KAKU2_ROTATED = 84
Private Const DMPAPER_JENV_KAKU3_ROTATED = 85
Private Const DMPAPER_JENV_CHOU3_ROTATED = 86
Private Const DMPAPER_JENV_CHOU4_ROTATED = 87
Private Const DMPAPER_B6_JIS = 88
Private Const DMPAPER_B6_JIS_ROTATED = 89
Private Const DMPAPER_12X11 = 90
Private Const DMPAPER_JENV_YOU4 = 91
Private Const DMPAPER_JENV_YOU4_ROTATED = 92
Private Const DMPAPER_P16K = 93
Private Const DMPAPER_P32K = 94
Private Const DMPAPER_P32KBIG = 95
Private Const DMPAPER_PENV_1 = 96
Private Const DMPAPER_PENV_2 = 97
Private Const DMPAPER_PENV_3 = 98
Private Const DMPAPER_PENV_4 = 99
Private Const DMPAPER_PENV_5 = 100
Private Const DMPAPER_PENV_6 = 101
Private Const DMPAPER_PENV_7 = 102
Private Const DMPAPER_PENV_8 = 103
Private Const DMPAPER_PENV_9 = 104
Private Const DMPAPER_PENV_10 = 105
Private Const DMPAPER_P16K_ROTATED = 106
Private Const DMPAPER_P32K_ROTATED = 107
Private Const DMPAPER_P32KBIG_ROTATED = 108
Private Const DMPAPER_PENV_1_ROTATED = 109
Private Const DMPAPER_PENV_2_ROTATED = 110
Private Const DMPAPER_PENV_3_ROTATED = 111
Private Const DMPAPER_PENV_4_ROTATED = 112
Private Const DMPAPER_PENV_5_ROTATED = 113
Private Const DMPAPER_PENV_6_ROTATED = 114
Private Const DMPAPER_PENV_7_ROTATED = 115
Private Const DMPAPER_PENV_8_ROTATED = 116
Private Const DMPAPER_PENV_9_ROTATED = 117
Private Const DMPAPER_PENV_10_ROTATED = 118

Private Const DMORIENT_LANDSCAPE = 2
Private Const DMORIENT_PORTRAIT = 1

Private Const DMRES_DRAFT = (-1)
Private Const DMRES_HIGH = (-4)
Private Const DMRES_LOW = (-2)
Private Const DMRES_MEDIUM = (-3)

Private Const DMCOLOR_COLOR = 2
Private Const DMCOLOR_MONOCHROME = 1
Private Const DM_GRAYSCALE = &H1

' Für die Abfrage des Geräts mit DeviceCapabilities
Private Const DC_BINADJUST = 19
Private Const DC_BINNAMES = 12
Private Const DC_BINS = 6
Private Const DC_COLLATE = 22
Private Const DC_COPIES = 18
Private Const DC_DATATYPE_PRODUCED = 21
Private Const DC_DRIVER = 11
Private Const DC_DUPLEX = 7
Private Const DC_EMF_COMPLIANT = 20
Private Const DC_ENUMRESOLUTIONS = 13
Private Const DC_EXTRA = 9
Private Const DC_FIELDS = 1
Private Const DC_FILEDEPENDENCIES = 14
Private Const DC_HASDEFID = &H534
Private Const DC_MAXEXTENT = 5
Private Const DC_MINEXTENT = 4
Private Const DC_ORIENTATION = 17
Private Const DC_PAPERNAMES = 16
Private Const DC_PAPERS = 2
Private Const DC_PAPERSIZE = 3
Private Const DC_SIZE = 8
Private Const DC_TRUETYPE = 15
Private Const DC_VERSION = 10

Private Declare Function lstrcpy _
   Lib "kernel32.dll" Alias "lstrcpyA" ( _
   ByVal lpString1 As String, _
   ByVal lpString2 As Long _
   ) As Long
Private Declare Function lstrlen _
   Lib "kernel32.dll" Alias "lstrlenA" ( _
   ByVal lpString As Long _
   ) As Long
Private Declare Sub CopyMemory _
   Lib "kernel32" Alias "RtlMoveMemory" ( _
   Destination As Any, _
   Source As Any, _
   ByVal Length As Long)
Private Declare Function DeviceCapabilities _
   Lib "winspool.drv" Alias "DeviceCapabilitiesA" ( _
   ByVal lpDeviceName As String, _
   ByVal lpPort As String, _
   ByVal iIndex As Long, _
   lpOutput As Any, _
   ByVal dev As Long _
   ) As Long
Private Declare Function EnumPrinters _
   Lib "winspool.drv" Alias "EnumPrintersA" ( _
   ByVal flags As Long, _
   ByVal name As String, _
   ByVal Level As Long, _
   pPrinterEnum As Long, _
   ByVal cdBuf As Long, _
   pcbNeeded As Long, _
   pcReturned As Long _
   ) As Long

Public audtDruckerinfo()   As Printerinfos

Public Sub DruckerListe()
Dim arrBuffer()         As Long
Dim lngLänge            As Long
Dim lngzähler           As Long
Dim lngAnzahl           As Long
Dim lngRück             As Long
Dim lngBuffZähler       As Long
Dim PrinterTyp          As Long
Dim strNames            As String
Dim aintPapersize()     As Integer
Dim udtSec              As SECURITY_DESCRIPTOR
Dim udtDevMode          As DEVMODE
Dim lngRet              As Long
Dim i                   As Long

   ReDim arrBuffer(1)
   PrinterTyp = PRINTER_ENUM_LOCAL

   'Buffergröße ermitteln
   lngRück = EnumPrinters(PrinterTyp, _
      vbNullString, 2, _
      arrBuffer(0), 0, _
      lngLänge, lngAnzahl)

   'Buffer bereitstellen (Ausrichtung Doppelwortgrenze beachten)
   ReDim arrBuffer(0 To (lngLänge + 3) \ 4)

   'Infos über Drucker holen
   lngRück = EnumPrinters(PrinterTyp, vbNullString, _
    2, arrBuffer(0), lngLänge, lngLänge, lngAnzahl)
   If lngAnzahl = 0 Then MsgBox "Keine Drucker verfügbar": Exit Sub

   ReDim audtDruckerinfo(1 To lngAnzahl)
   For lngzähler = 1 To lngAnzahl
      'Zeilenumbruch für Liste erzeugen

      With audtDruckerinfo(lngzähler)


         .ServerName = StringVonPointer(arrBuffer(lngBuffZähler))
         lngBuffZähler = lngBuffZähler + 1

         .PrinterName = StringVonPointer(arrBuffer(lngBuffZähler))
         lngBuffZähler = lngBuffZähler + 1

         .ShareName = StringVonPointer(arrBuffer(lngBuffZähler))
         lngBuffZähler = lngBuffZähler + 1

         .PortName = StringVonPointer(arrBuffer(lngBuffZähler))
         lngBuffZähler = lngBuffZähler + 1

         .DriverName = StringVonPointer(arrBuffer(lngBuffZähler))
         lngBuffZähler = lngBuffZähler + 1

         .Comment = StringVonPointer(arrBuffer(lngBuffZähler))
         lngBuffZähler = lngBuffZähler + 1

         .Location = StringVonPointer(arrBuffer(lngBuffZähler))
         lngBuffZähler = lngBuffZähler + 1

         ' Pointer auf DEVMODE
         CopyMemory udtDevMode, ByVal arrBuffer(lngBuffZähler), Len(udtDevMode)
         lngBuffZähler = lngBuffZähler + 1

         .SepFile = StringVonPointer(arrBuffer(lngBuffZähler))
         lngBuffZähler = lngBuffZähler + 1

         .PrintProcessor = StringVonPointer(arrBuffer(lngBuffZähler))
         lngBuffZähler = lngBuffZähler + 1

         .Datatype = StringVonPointer(arrBuffer(lngBuffZähler))
         lngBuffZähler = lngBuffZähler + 1

         .Parameters = StringVonPointer(arrBuffer(lngBuffZähler))
         lngBuffZähler = lngBuffZähler + 1

         ' Security
'         If arrBuffer(lngBuffZähler) <> 0 Then
'            CopyMemory udtSec, ByVal arrBuffer(lngBuffZähler), _
'               Len(udtSec)
'         End If
         lngBuffZähler = lngBuffZähler + 1

         ' Attributes
         lngBuffZähler = lngBuffZähler + 1

         .Priority = arrBuffer(lngBuffZähler)
         lngBuffZähler = lngBuffZähler + 1

         .DefaultPriority = arrBuffer(lngBuffZähler)
         lngBuffZähler = lngBuffZähler + 1

         ' Specifies the time at which the
         ' printer will print a job. This value is
         ' expressed as minutes elapsed since 12:00
         ' A.M. GMT (Greenwich Mean Time)
         .StartTime = arrBuffer(lngBuffZähler)
         lngBuffZähler = lngBuffZähler + 1
         .UntilTime = arrBuffer(lngBuffZähler)
         lngBuffZähler = lngBuffZähler + 1

         .Status = arrBuffer(lngBuffZähler)
         lngBuffZähler = lngBuffZähler + 1

         .Jobs = arrBuffer(lngBuffZähler)
         lngBuffZähler = lngBuffZähler + 1

         .AveragePPM = arrBuffer(lngBuffZähler)
         lngBuffZähler = lngBuffZähler + 1

         ' DEVMODE auswerten
         .DeviceName = StringVonAsciiZ(udtDevMode.dmDeviceName)
         Select Case udtDevMode.dmOrientation
            Case DMORIENT_PORTRAIT
               .Orientation = "PORTRAIT"
            Case DMORIENT_LANDSCAPE
               .Orientation = "LANDSCAPE"
         End Select

         Select Case udtDevMode.dmPaperSize
            Case DMPAPER_A2
               .PaperSize = "A2"
            Case DMPAPER_A3
               .PaperSize = "A3"
            Case DMPAPER_A4
               .PaperSize = "A4"
            Case DMPAPER_A5
               .PaperSize = "A5"
         End Select

         Select Case udtDevMode.dmPrintQuality
            Case Is > 0
               .PrintQuality = udtDevMode.dmPrintQuality
            Case DMRES_DRAFT
               .PrintQuality = "Entwurf"
            Case DMRES_LOW
               .PrintQuality = "Niedrig"
            Case DMRES_MEDIUM
               .PrintQuality = "Mittel"
            Case DMRES_HIGH
               .PrintQuality = "Hoch"
         End Select

         Select Case udtDevMode.dmColor
            Case DMCOLOR_COLOR
               .Color = "Farbig"
            Case DMCOLOR_MONOCHROME
               .Color = "MONOCHROME"
         End Select

         .YResolution = udtDevMode.dmYResolution

         ' Unterstützte Blätter
         ' Pufferlänge holen
         lngRet = DeviceCapabilities(.PrinterName, .PortName, _
              DC_PAPERNAMES, ByVal vbNullString, 0&)
         strNames = String$(64 * lngRet, 0)
         ' Liste mit Papiernamen holen
         lngRet = DeviceCapabilities(.PrinterName, .PortName, _
              DC_PAPERNAMES, ByVal strNames, 0&)
         ' Jede Papiersorte in eine Zeile
         For i = 1 To lngRet
            If i > 1 Then .Papernames = .Papernames & vbCrLf
            .Papernames = .Papernames & StringVonAsciiZ( _
               Mid(strNames, (i - 1) * 64 + 1, 64))
         Next

      End With
   Next
End Sub

Private Function StringVonPointer(plngAscii As Long)
Dim lngAnzahl  As Long
Dim strName    As String
   lngAnzahl = lstrlen(plngAscii)
   strName = String(lngAnzahl, 0)
   lstrcpy strName, plngAscii
   If InStr(1, strName, Chr(0)) <> 0 Then
       strName = Left$(strName, InStr(1, strName, Chr(0)) - 1)
   End If
   StringVonPointer = strName
End Function

Private Function StringVonAsciiZ(ASCIIZ As String)
'ASCIIZ String kürzen
If InStr(1, ASCIIZ, Chr(0)) > 0 Then
    StringVonAsciiZ = Left$(ASCIIZ, InStr(1, ASCIIZ, Chr(0)) - 1)
Else
    StringVonAsciiZ = ASCIIZ
End If
End Function