Deklaration: Declare Function EnumPorts Lib "winspool.drv" _ Alias "EnumPortsA" ( _ ByVal pName As String, _ ByVal Level As Long, _ pPorts As Any, _ ByVal cbBuf As Long, _ pcbNeeded As Long, _ pcReturned As Long) As Long Beschreibung: Parameter:
Rückgabewert: Beispiel: Private Declare Function EnumPorts Lib "winspool.drv" _ Alias "EnumPortsA" ( _ ByVal pName As String, _ ByVal Level As Long, _ pPorts As Any, _ ByVal cbBuf As Long, _ pcbNeeded As Long, _ pcReturned As Long) As Long Private Declare Function ConfigurePort Lib "winspool.drv" _ Alias "ConfigurePortA" ( _ ByVal pName As String, _ ByVal hwnd As Long, _ ByVal pPortName As String) As Long Private Declare Function lstrlen Lib "kernel32" _ Alias "lstrlenA" ( _ ByVal lpString As Any) As Long Private Declare Function lstrcpy Lib "kernel32" _ Alias "lstrcpyA" ( _ ByVal lpString1 As Any, _ ByVal lpString2 As Any) As Long Private Type PORT_INFO_2 pPortName As Long pMonitorName As Long pDescription As Long fPortType As Long Reserved As Long End Type ' PORT_INFO_2 fPortType-Konstanten Private Const PORT_TYPE_WRITE = &H1 ' Schreiben auf dem Port ist möglich Private Const PORT_TYPE_READ = &H2 ' Lesen des Ports ist möglich Private Const PORT_TYPE_REDIRECTED = &H4 ' Der Port ist im Offlinedruck, Schema ist akteviert Private Const PORT_TYPE_NET_ATTACHED = &H8 ' Der Drucker ist ein Netzwerkdrucker ' eine der Standard Fehlerkonstanten Private Const ERROR_CANCELLED = 1223 Dim Ports() As PORT_INFO_2 ' String anhand eines Pointers ermitteln Private Function PtrToString(ByVal StringPtr As Long) As String Dim TmpStr As String TmpStr = Space(lstrlen(StringPtr)) Call lstrcpy(TmpStr, StringPtr) PtrToString = TmpStr End Function ' Alle Ports ermitteln und Combobox damit füllen Private Sub Form_Load() Dim Retval As Long, BufferSize As Long Dim CountPorts As Long Dim I As Integer ' Anzahl Ports ermitteln Retval = EnumPorts(vbNullChar, 2, ByVal 0&, 0&, BufferSize, CountPorts) ' Puffer erstellen und Portinfos ermitteln ReDim Ports(BufferSize / Len(Ports(0)) + 1) Retval = EnumPorts(vbNullChar, 2, Ports(0), Len(Ports(0)) * _ (UBound(Ports) + 1), BufferSize, CountPorts) ' Namen jedes Ports ermitteln For I = 0 To CountPorts - 1 Combo1.AddItem PtrToString(Ports(I).pPortName) Next I If Combo1.ListCount < 0 Then Combo1.ListIndex = 0 Else Command1.Enabled = False End If End Sub ' Portinfos ausgeben Private Sub Combo1_Click() With Ports(Combo1.ListIndex) Debug.Print "Port: " & PtrToString(.pPortName) Debug.Print "Beschreibung: " & PtrToString(.pDescription) Debug.Print "Monitor: " & PtrToString(.pMonitorName) Debug.Print vbTab & "Schreiben: " & CBool(PORT_TYPE_WRITE And .fPortType) Debug.Print vbTab & "Lesen: " & CBool(PORT_TYPE_READ And .fPortType) Debug.Print vbTab & "Netzwerkport: " & _ CBool(PORT_TYPE_NET_ATTACHED And .fPortType) Debug.Print vbTab & "Offlinedruck: " & CBool(PORT_TYPE_REDIRECTED _ And .fPortType) Debug.Print vbCrLf & "- - - - - - - - - - - - - - - - - - -" End With End Sub ' Anschluss konfigurieren Private Sub Command1_Click() Dim Retval As Long Retval = ConfigurePort(vbNullString, Me.hwnd, Combo1.Text) If Retval = 0 Then If Err.LastDllError = ERROR_CANCELLED Then MsgBox "Der Dialog wurde abgebrochen.", vbInformation, _ "Dialog geschlossen" Else MsgBox "Der Port ist nicht verfügbar.", vbInformation, _ "Fehler " & Err.LastDllError End If End If End Sub Diese Seite wurde bereits 9.397 mal aufgerufen. |
TOP! Unser Nr. 1 Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Buchempfehlung Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||||||||
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. |