Druckermodell auslesen
25.05.2004 14:29:11
Steffen
Es werden alle installierten Druckermodelle aufgelistet.
Allerdings brauche ich nur den Standarddrucker, in diesem Beispielt ist immer der erste Drucker der Standard drucker.
kann mit wer helfen?
Besten dank
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
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Const ACL_REVISION = (2) 'AclRevision-Konstante
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 Const CCHFORMNAME = 32 'Pufferlänge-Konstante
Private Const CCHDEVICENAME = 32 'Pufferlänge-Konstante
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 Integer
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 DEVMODE
pSepFile As String
pPrintProcessor As String
pDatatype As String
pParameters As String
pSecurityDescriptor As 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
'PRINTER_INFO_2 Attributes-Konstanten
Private Const PRINTER_ATTRIBUTE_DEFAULT = &H4 'Der Drucker ist der Standarddrucker
Private Const PRINTER_ATTRIBUTE_DIRECT = &H2 'Der Drucker hat eine Direkte Verbindung mit dem System
Private Const PRINTER_ATTRIBUTE_DO_COMPLETE_FIRST = &H200 'Erledigt die Ausdrucke (Jobs) per "First Serve Basis"
Private Const PRINTER_ATTRIBUTE_ENABLE_BIDI = &H800 'Akteviert BDI
Private Const PRINTER_ATTRIBUTE_ENABLE_DEVQ = &H80 'Akteviert DEVQ
Private Const PRINTER_ATTRIBUTE_KEEPPRINTEDJOBS = &H100 'Der Drucker hält Informationen von den Ausdrücken (Jobs)
Private Const PRINTER_ATTRIBUTE_QUEUED = &H1 'Der Drucker unterstützt eine Ausdruck warteliste
Private Const PRINTER_ATTRIBUTE_SHARED = &H8 'Der Drucker ist ein Netzwerkdrucker
Private Const PRINTER_ATTRIBUTE_WORK_OFFLINE = &H400 'Der Drucker kann Offline Arbeiten
'PRINTER_INFO_2 Status-Konstanten
Private Const PRINTER_STATUS_BUSY = &H200 'Der Drucker ist nicht bereit
Private Const PRINTER_STATUS_DOOR_OPEN = &H400000 'Die klappe des Druckers ist geöffnet
Private Const PRINTER_STATUS_ERROR = &H2 'Es liegt ein Druckerfehler vor
Private Const PRINTER_STATUS_INITIALIZING = &H8000 'Der Drucker wird Initialisiert
Private Const PRINTER_STATUS_IO_ACTIVE = &H100 'Eine Datenkomunikation mit dem Drucker findet statt
Private Const PRINTER_STATUS_MANUAL_FEED = &H20 'Der Drucker ladet papier mit manuellen Papiereinzug nach
Private Const PRINTER_STATUS_NO_TONER = &H40000 'Der Drucker hat keine Farbe mehr
Private Const PRINTER_STATUS_NOT_AVAILABLE = &H1000 'Es kann nicht auf den Drucker zugegriffen werden
Private Const PRINTER_STATUS_OFFLINE = &H80 'Der Drucker ist Offline
Private Const PRINTER_STATUS_OUT_OF_MEMORY = &H200000 'Der Drucker hat nicht genügend speicher zum fortsetzen der letzten Aktion
Private Const PRINTER_STATUS_OUTPUT_BIN_FULL = &H800 'Das Papierausgabefach ist voll
Private Const PRINTER_STATUS_PAGE_PUNT = &H80000 'Der Druck wurde wegen zu hoher Komplexität abgebrochen
Private Const PRINTER_STATUS_PAPER_JAM = &H8 'Das Drucker papier kann nicht nachgezogen werden
Private Const PRINTER_STATUS_PAPER_OUT = &H10 'Das Druckerpapier ist leer
Private Const PRINTER_STATUS_PAPER_PROBLEM = &H40 'Es liegt ein Problem mit der Papierzufuhr vor
Private Const PRINTER_STATUS_PAUSED = &H1 '(Win NT) Der Drucker befindet sich in eine Pause-Phase
Private Const PRINTER_STATUS_PENDING_DELETION = &H4 '(Win NT) Die Ausdrucke in der warteschleife werden gelöscht
Private Const PRINTER_STATUS_PRINTING = &H400 'Der Drucker durckt
Private Const PRINTER_STATUS_PROCESSING = &H4000 'Der Drucker erhält Informationen
Private Const PRINTER_STATUS_TONER_LOW = &H20000 'Die Farbpatronen des Drucker gehen zur neige
Private Const PRINTER_STATUS_USER_INTERVENTION = &H100000 'Der Benutzer hat in die Druckeraktion eingegriffen
Private Const PRINTER_STATUS_WAITING = &H2000 'Der Drucker wartet
Private Const PRINTER_STATUS_WARMING_UP = &H10000 'Der Drucker wärmt sich auf
'EnumPrinters flags-Konstanten
Private Const PRINTER_ENUM_CONNECTIONS = &H4 '(Win NT) PRINTER_INFO_4-Konstante für Informationen über Netzwerkdrucker
Private Const PRINTER_ENUM_DEFAULT = &H1 '(Win 9x) Ermittelt Informationen über den Standarddrucker des Systems
Private Const PRINTER_ENUM_Local = &H2 'Ermittel alle Lokalen Drucker
Private Const PRINTER_ENUM_NAME = &H8 'Ermittelt alle Drucker anhand des Netzwerknamens (Name-Variabel der Funktion)
Private Const PRINTER_ENUM_NETWORK = &H40 '(Win NT) PRINTER_INFO_4-Konstante. Ermittelt alle Netzwerkdrucker einer Domain
Private Const PRINTER_ENUM_REMOTE = &H10 '(Win NT) PRINTER_INFO_4-Konstante. Ermittelt alle Netzwerkdrucker einer Domain
Private Const PRINTER_ENUM_SHARED = &H20 'Ermittelt alle Drucker mit eingeschränktem zugriff
'Enumeriert alle verfügbaren Drucker
Private Sub Command1_Click()
Dim Retval As Long, Printers() As PRINTER_INFO_2
Dim TmpBuffer() As Long, BuffSizeNeed As Long, NumPrinters As Long
'Alle Druckerinformationen ermitteln
ReDim TmpBuffer(0)
Retval = EnumPrinters(PRINTER_ENUM_Local, vbNullString, 2, TmpBuffer(0), (UBound(TmpBuffer) + 1) * 4, BuffSizeNeed, NumPrinters)
ReDim TmpBuffer(BuffSizeNeed / 4)
Retval = EnumPrinters(PRINTER_ENUM_Local, vbNullString, 2, TmpBuffer(0), (UBound(TmpBuffer) + 1) * 4, BuffSizeNeed, NumPrinters)
'Die Druckerinformationen manuell in die Strukturen Kopieren
ReDim Printers(NumPrinters - 1)
For i = 0 To NumPrinters - 1
With Printers(i)
CopyStrVar .pServerName, TmpBuffer(i * 21)
CopyStrVar .pPrinterName, TmpBuffer(i * 21 + 1)
CopyStrVar .pShareName, TmpBuffer(i * 21 + 2)
CopyStrVar .pPortName, TmpBuffer(i * 21 + 3)
CopyStrVar .pDriverName, TmpBuffer(i * 21 + 4)
CopyStrVar .pComment, TmpBuffer(i * 21 + 5)
CopyStrVar .pLocation, TmpBuffer(i * 21 + 6)
MoveMemory .pDevMode, TmpBuffer(i * 21 + 7), Len(.pDevMode)
CopyStrVar .pSepFile, TmpBuffer(i * 21 + 8)
CopyStrVar .pPrintProcessor, TmpBuffer(i * 21 + 9)
CopyStrVar .pDatatype, TmpBuffer(i * 21 + 10)
CopyStrVar .pParameters, TmpBuffer(i * 21 + 11)
If TmpBuffer(i * 21 + 12) <> 0 Then MoveMemory .pSecurityDescriptor, ByVal TmpBuffer(i * 21 + 12), Len(.pSecurityDescriptor)
.Attributes = TmpBuffer(i * 21 + 13)
.Priority = TmpBuffer(i * 21 + 14)
.DefaultPriority = TmpBuffer(i * 21 + 15)
.StartTime = TmpBuffer(i * 21 + 16)
.UntilTime = TmpBuffer(i * 21 + 17)
.Status = TmpBuffer(i * 21 + 18)
.cJobs = TmpBuffer(i * 21 + 19)
.AveragePPM = TmpBuffer(i * 21 + 20)
'Druckerinformationen ausgeben
If CBool(PRINTER_ENUM_DEFAULT) = True Then
MsgBox "Drucker: " & .pPrinterName & " (Standarddrucker)"
Else
MsgBox "Drucker: " & .pPrinterName
End If
'MsgBox PRINTER_ATTRIBUTE_DEFAULT
MsgBox "Port: " & .pPortName & vbCr & _
"Treiber: " & .pDriverName & vbCr & _
"Bemerkung: " & .pComment & vbCr & _
"Leistung: " & .AveragePPM & " Seiten pro Minute" & vbCr & _
End With
Next i
End Sub
'Kopiert einen String anhand eines Pointers in eine String-Variabel
Private Function CopyStrVar(ByRef StrDest As String, ByRef VarSrc As Long)
StrDest = Space(lstrlen(VarSrc))
MoveMemory ByVal StrDest, ByVal VarSrc, Len(StrDest)
End Function