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
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
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货