Zurück zur Homepage

Infos über Drucker auslesen

 Beispieldatei (Druckinfo.zip 30 kB) 

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