Option Explicit
Dim buffer As StringPrivate Sub cmdStart_Click()
    StartCheck 4
End SubPublic Sub StartCheck(CheckCount As Integer)
Dim iCount As Integer
    If (Len(CheckCount) = 0 Or Val(CheckCount) = 0) Then MsgBox "请指定一个有效的数目", vbInformation: Exit Sub
    For iCount = 1 To CheckCount
        Call CheckPort(iCount)
    Next
End SubPrivate Sub CheckPort(X As Integer)
    If X <> 1 Then PrintText "---------------------"
    PrintText "Checking COM" & Trim(Str(X)) & "..."
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    On Error GoTo ErrorHandler
    MSComm1.CommPort = X
    MSComm1.Settings = "9600,N,8,1"
    MSComm1.InputLen = 0
    MSComm1.PortOpen = True
    On Error GoTo 0
    
    MSComm1.Output = "ATI1" & Chr$(13)
    If WaitForResponse(2) = False Then GoTo NothingReturned
    MSComm1.Output = "ATI3" & Chr$(13)
    If WaitForResponse(2) = False Then GoTo NothingReturned
    PrintText ParseBuffer(buffer)
    PrintText "COM" & Trim(Str(X)) & " 端口安装了Modem"
NothingReturned:
    MSComm1.PortOpen = False
    Exit Sub
ErrorHandler:
    PrintText ErrorString(Err.Number)
End SubPrivate Function WaitForResponse(X As Integer) As Boolean
Dim sTimer As String
    WaitForResponse = False
    buffer = ""
    sTimer = Time
    Do
        DoEvents
        buffer = buffer & MSComm1.Input
        If Len(buffer) <> 0 Then
            If InStr(1, buffer, "OK") <> 0 Then
                WaitForResponse = True
                Exit Function
            End If
        End If
        If DateDiff("s", sTimer, Time) >= X Then
            Exit Function
        End If
    Loop
End FunctionPrivate Sub PrintText(X As String)
    AutoRedraw = True
    Print X
End SubPrivate Function ParseBuffer(X As String) As String
Dim i As Integer
Dim Splitter As String
Dim Pos1, Pos2 As Integer
    Splitter = Chr(13) & Chr(10)
    Pos1 = InStr(1, X, Splitter)
    Pos2 = InStr(Pos1 + 2, X, Splitter)
    
    ParseBuffer = Mid(X, Pos1 + 2, Pos2 - Pos1 - 2)
End FunctionPrivate Function ErrorString(X As Long) As String
    Select Case X
        Case 8021: ErrorString = "内部错误"
        Case 394:  ErrorString = "属性只写"
        Case 380:  ErrorString = "无效的属性值"
        Case 8012: ErrorString = "设备未打开"
        Case 8005: ErrorString = "端口已打开"
        Case 8002: ErrorString = "无效的端口号"
        Case 8018: ErrorString = "仅当端口已打开时操作有效"
        Case 8000: ErrorString = "当端口已打开时操作无效"
        Case 8020: ErrorString = "读取设备时发生错误"
        Case 8015: ErrorString = "不能设置通信状态,可能是你输入的通信参数不正确"
        Case 383:  ErrorString = "属性只读"
        Case Else: ErrorString = "其他错误..."
    End Select
End Function