Option Explicit

Dim maxBaud As String
Dim ComPort As String
Dim i As Integer

Private Sub Command1_Click()
  ComPort = ""
  maxBaud = ""

  Label1(0).Caption = ""
  Label1(1).Caption = ""

  For i = 0 To 4
    Label1(i).Visible = False
  Next

  Command1.Enabled = False
  Command2.Enabled = False
  Me.MousePointer = vbHourglass

  DoEvents
  SearchModem

  If Not ComPort = "" Then
    For i = 0 To 4
      Label1(i).Visible = True
    Next

    Label1(4).ForeColor = &H8000&
    Label1(4).Caption = "Modem gefunden an:"

    Label1(0).Caption = " " & ComPort
    Label1(1).Caption = " " & maxBaud
  Else
    Label1(4).ForeColor = &HFF&
    Label1(4).Caption = "Kein Modem gefunden!"
    Label1(4).Visible = True
  End If

  Command1.Enabled = True
  Command2.Enabled = True
  Me.MousePointer = vbDefault
End Sub

Private Function SearchModem()
  Dim j As Integer
  Dim BaudRate()

  On Error Resume Next

  BaudRate = Array("256000", "128000", "115200", "57600", _
        "56000", "38400", "28800", "19200", "14400", "9600", _
        "4800", "2400", "1200", "600", "300", "110")

  Label1(4).Visible = True
  Label1(4).ForeColor = &H0&

  For i = 1 To 4
    Label1(4).Caption = "Teste COM-Port" & Str(i)
    MSComm1.CommPort = i

    MSComm1.Settings = "9600,N,8,1"
    
    MSComm1.PortOpen = True
    DoEvents
    If MSComm1.DSRHolding = True And MSComm1.CTSHolding = True Then
      ComPort = "COM" & MSComm1.CommPort

      For j = 15 To 0 Step -1
        MSComm1.PortOpen = False
        MSComm1.Settings = BaudRate(j) & ",N,8,1"
        Err = 0
        MSComm1.PortOpen = True

        If Err = 0 Then
           maxBaud = BaudRate(j) & " Kbps"
        Else
          Exit For
        End If
      Next j

      MSComm1.PortOpen = False
    End If

    MSComm1.PortOpen = False
  Next
End Sub