Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » System

Vorhandene Ports (Schnittstellen) unter Windows ermitteln

Lizenz:Erster Autor:Letzte Bearbeitung:
FBPSLAdministratorSebastian 19.02.2016

Unter Windows lassen sich die vorhandenen Ports bzw. Schnittstellen des Systems über die WinAPI-Funktion Externer Link!EnumPorts ermitteln. Im Erfolgsfall liefert sie einen Speicherbereich mit Externer Link!PORT_INFO-Strukturen zurück.

Der folgende Quelltext gibt eine Übersicht wie diese aus:

Portliste
Vergrößern
Portliste

FreeBASIC-Code:

'Vorhandene Ports/Schnittstellen unter Windows ermitteln
'---
''''Getestet mit FreeBASIC 0.23.0 unter Windows 7 (64-Bit)
'[Volta] Getestet mit FreeBASIC 1.04.0 unter Windows 10 (64-Bit)
'Lizenz: FBPSL
'Keine Gewaehrleistung fuer Korrektheit und Funktionalitaet des Codes!
'Verwendung auf eigene Gefahr.

'Fuer Details siehe:
' - http://msdn.microsoft.com/en-us/library/windows/desktop/dd162687%28v=vs.85%29.aspx
' - http://msdn.microsoft.com/en-us/library/windows/desktop/dd162823%28v=vs.85%29.aspx

#Include "windows.bi"
#Include "win\winspool.bi"

Dim Result As BOOL
Dim bufferLen As Long '<- geändert
Dim numResults As Long'<- geändert
Dim errorCode As Integer

ScreenRes 640,480
Width 640/8, 480/16

Print "Vorhandene Ports (insb. COM-Ports) ermitteln"
Print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
Print

'Zunaechst erst mal nur pruefen, wie gross der Ergebnispuffer fuer
'die Funktion sein muss. Dafuer lassen wir den Aufruf einfach scheitern
'und interessieren uns nur fuer den Wert in bufferLen.

Result = EnumPorts ( _
    NULL, _
    2, _  'entweder 1 oder 2  (2 fuer ausfuehrlichere Infos)
    NULL, _
    0, _  'Puffergroesse in Bytes. 0=erst mal nur schauen, wie lang der Puffer sein muss
    @bufferLen, _
    @numResults _
)

errorCode = GetLastError()

If (errorCode <> ERROR_INSUFFICIENT_BUFFER) Then
    Print "Fehler!"
    Print "Die Funktion lieferte einen unbekannten Fehlercode zurueck."
    Sleep: End 1
Else
    Print "Info: Die Ergebnismenge, die wir im naechsten Schritt abrufen wollen,"
    Print "benoetigt " & bufferLen & " Bytes als Puffer."
    Print
End If

Dim resultBuffer As Byte Ptr
Dim allocBufferLen As Integer = bufferLen + 1
resultBuffer = CAllocate(allocBufferLen)

Result = EnumPorts ( _
    NULL, _
    2, _  'entweder 1 oder 2  (2 fuer ausfuehrlichere Infos)
    Cast(LPBYTE, resultBuffer), _  'Ergebnispuffer
    allocBufferLen, _  'Puffergroesse in Bytes
    @bufferLen, _
    @numResults _
)

Print "Info: Es wurden " & numResults & " Port-Info-Eintraege gefunden. ";
Print "Etwaige COM-Ports werden im"
Print "Folgenden rot ausgegeben:"
Print

Dim As Integer structLen, i, colorOld = LOWORD(COLOR)
Dim As Byte Ptr currentPointer = resultBuffer
Dim As PORT_INFO_2 resultEntry
Dim As String PortName, PortType

structLen = SizeOf(PORT_INFO_2)

Print "Pointer  | PortName     | MonitorName        | Beschreibung        | PortType"
Print "-------------------------------------------------------------------------------"

For i = 1 To numResults
    resultEntry = *(Cast(PORT_INFO_2 Ptr, currentPointer))
    PortName = Trim(*(resultEntry.pPortName))

    'Handelt es sich um einen COM-Port?
    'Wenn ja, rote Schrift benutzen!
    If ( (Len(PortName) > 4) ANDALSO _
         (UCase(Left(PortName,3)) = "COM") ANDALSO _
         (Right(PortName,1) = ":") ) Then
         Color 12
    End If

    'PortType auswerten:
    If (resultEntry.fPortType AND PORT_TYPE_READ) Then
        PortType = "R "
    Else
        PortType = ""
    End If
    If (resultEntry.fPortType AND PORT_TYPE_WRITE) Then PortType &= "W "
    If (resultEntry.fPortType AND PORT_TYPE_REDIRECTED) Then PortType &= "Rd "
    If (resultEntry.fPortType AND PORT_TYPE_NET_ATTACHED) Then PortType &= "N"

    Print Using "\      \ | \          \ | \                \ | \                 \ | \       \"; _
        Hex(Cast(UInteger, currentPointer),8); _
        *(resultEntry.pPortName); _
        *(IIf( _
            resultEntry.pMonitorName <> NULL, _
            resultEntry.pMonitorName, _
            StrPtr("---") _
        )); _
        *(resultEntry.pDescription); _
        PortType

    'Haben wir vorhin mit rot geschrieben? Dann auf grau zuruecksetzen.
    If (LOWORD(COLOR) = 12) Then
        Color colorOld
    End If

    currentPointer += structLen
Next i

DeAllocate resultBuffer

Sleep
End


Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 09.04.2012 von AdministratorSebastian angelegt.
  • Die aktuellste Version wurde am 19.02.2016 von RedakteurVolta gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen