我的VB与12台仪表通讯时，老是出现下标越界，求高手解答
下面是我的代码
Private Sub MSComm1_OnComm()
Dim data(10) As String
Dim D(6) As Variant
Dim Inbyte() As Byte
Dim buffer As String
Dim datatemp(10) As String
Dim sinSj1 As Single
Dim sinSj2 As Single
Dim sinSj3 As Single
Dim sinSj4 As Single
Dim buffer1(7) As Byte
Dim cn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim sqlstr As String
Dim strcon As String
Dim M As String
If n > 180 Then Call renew
Select Case MSComm1.CommEvent
Case comEvReceive
For i = 1 To 3000
For j = 1 To 5000
f = j
Next j
Next i
buffer = ""
Inbyte = MSComm1.Input
For i = LBound(Inbyte) To UBound(Inbyte)
If Len(Hex(Inbyte(i))) = 1 Then
buffer = buffer + "0" + Hex(Inbyte(i))
Else
buffer = buffer + Hex(Inbyte(i))
End If
Next i
If Hex(Inbyte(9)) = "0" Then '读浓度值 \\\\\\\\这一句出现下标越界
If Len(Hex(Inbyte(10))) = 1 Then
data(1) = "0"
data(2) = Mid(Hex(Inbyte(10)), 1, 1)
Else
data(1) = Mid(Hex(Inbyte(10)), 1, 1): data(2) = Mid(Hex(Inbyte(10)), 2, 1)
End If
If Len(Hex(Inbyte(11))) = 1 Then
data(3) = "0"
data(4) = Mid(Hex(Inbyte(11)), 1, 1)
Else
data(3) = Mid(Hex(Inbyte(11)), 1, 1): data(4) = Mid(Hex(Inbyte(11)), 2, 1)
End If
If Len(Hex(Inbyte(12))) = 1 Then
data(5) = "0"
data(6) = Mid(Hex(Inbyte(12)), 1, 1)
Else
data(5) = Mid(Hex(Inbyte(12)), 1, 1): data(6) = Mid(Hex(Inbyte(12)), 2, 1)
End If
If Len(Hex(Inbyte(13))) = 1 Then
data(7) = "0"
data(8) = Mid(Hex(Inbyte(13)), 1, 1)
Else
data(7) = Mid(Hex(Inbyte(13)), 1, 1): data(8) = Mid(Hex(Inbyte(13)), 2, 1)
End If
datatemp(1) = data(1) + data(2) + data(3) + data(4) + data(5) + data(6) + data(7) + data(8)
For i = 1 To Len(datatemp(1)) Step 2
buffer1((7 - i) / 2) = Val("&H" & Mid(datatemp(1), i, 2))
Next
CopyMemory ByVal VarPtr(sinSj1), ByVal VarPtr(buffer1(0)), 4
If Len(Hex(Inbyte(14))) = 1 Then
data(1) = "0"
data(2) = Mid(Hex(Inbyte(14)), 1, 1)
Else
data(1) = Mid(Hex(Inbyte(14)), 1, 1): data(2) = Mid(Hex(Inbyte(14)), 2, 1)
End If
If Len(Hex(Inbyte(15))) = 1 Then
data(3) = "0"
data(4) = Mid(Hex(Inbyte(15)), 1, 1)
Else
data(3) = Mid(Hex(Inbyte(15)), 1, 1): data(4) = Mid(Hex(Inbyte(15)), 2, 1)
End If
If Len(Hex(Inbyte(16))) = 1 Then
data(5) = "0"
data(6) = Mid(Hex(Inbyte(16)), 1, 1)
Else
data(5) = Mid(Hex(Inbyte(16)), 1, 1): data(6) = Mid(Hex(Inbyte(16)), 2, 1)
End If
If Len(Hex(Inbyte(17))) = 1 Then
data(7) = "0"
data(8) = Mid(Hex(Inbyte(10)), 1, 1)
Else
data(7) = Mid(Hex(Inbyte(17)), 1, 1): data(8) = Mid(Hex(Inbyte(17)), 2, 1)
End If
datatemp(2) = data(1) + data(2) + data(3) + data(4) + data(5) + data(6) + data(7) + data(8)
For i = 1 To Len(datatemp(2)) Step 2
buffer1((7 - i) / 2) = Val("&H" & Mid(datatemp(2), i, 2))
Next
CopyMemory ByVal VarPtr(sinSj2), ByVal VarPtr(buffer1(0)), 4
If Len(Hex(Inbyte(18))) = 1 Then
data(1) = "0"
data(2) = Mid(Hex(Inbyte(18)), 1, 1)
Else
data(1) = Mid(Hex(Inbyte(18)), 1, 1): data(2) = Mid(Hex(Inbyte(18)), 2, 1)
End If
If Len(Hex(Inbyte(19))) = 1 Then
data(3) = "0"
data(4) = Mid(Hex(Inbyte(19)), 1, 1)
Else
data(3) = Mid(Hex(Inbyte(19)), 1, 1): data(4) = Mid(Hex(Inbyte(19)), 2, 1)
End If
If Len(Hex(Inbyte(20))) = 1 Then
data(5) = "0"
data(6) = Mid(Hex(Inbyte(10)), 1, 1)
Else
data(5) = Mid(Hex(Inbyte(20)), 1, 1): data(6) = Mid(Hex(Inbyte(20)), 2, 1)
End If
If Len(Hex(Inbyte(21))) = 1 Then
data(7) = "0"
data(8) = Mid(Hex(Inbyte(21)), 1, 1)
Else
data(7) = Mid(Hex(Inbyte(21)), 1, 1): data(8) = Mid(Hex(Inbyte(21)), 2, 1)
End If
datatemp(3) = data(1) + data(2) + data(3) + data(4) + data(5) + data(6) + data(7) + data(8)
For i = 1 To Len(datatemp(3)) Step 2
buffer1((7 - i) / 2) = Val("&H" & Mid(datatemp(3), i, 2))
Next
CopyMemory ByVal VarPtr(sinSj3), ByVal VarPtr(buffer1(0)), 4
If Len(Hex(Inbyte(22))) = 1 Then
data(1) = "0"
data(2) = Mid(Hex(Inbyte(22)), 1, 1)
Else
data(1) = Mid(Hex(Inbyte(22)), 1, 1): data(2) = Mid(Hex(Inbyte(22)), 2, 1)
End If
If Len(Hex(Inbyte(23))) = 1 Then
data(3) = "0"
data(4) = Mid(Hex(Inbyte(23)), 1, 1)
Else
data(3) = Mid(Hex(Inbyte(23)), 1, 1): data(4) = Mid(Hex(Inbyte(23)), 2, 1)
End If
If Len(Hex(Inbyte(24))) = 1 Then
data(5) = "0"
data(6) = Mid(Hex(Inbyte(24)), 1, 1)
Else
data(5) = Mid(Hex(Inbyte(24)), 1, 1): data(6) = Mid(Hex(Inbyte(24)), 2, 1)
End If
If Len(Hex(Inbyte(25))) = 1 Then
data(7) = "0"
data(8) = Mid(Hex(Inbyte(25)), 1, 1)
Else
data(7) = Mid(Hex(Inbyte(25)), 1, 1): data(8) = Mid(Hex(Inbyte(25)), 2, 1)
End If
datatemp(4) = data(1) + data(2) + data(3) + data(4) + data(5) + data(6) + data(7) + data(8)
For i = 1 To Len(datatemp(4)) Step 2
buffer1((7 - i) / 2) = Val("&H" & Mid(datatemp(4), i, 2))
Next
CopyMemory ByVal VarPtr(sinSj4), ByVal VarPtr(buffer1(0)), 4
Text1.Text = Val(Trim(StrConv(Mid(Inbyte, 2, 7), vbUnicode)))
M = "A" & Mid(Text1.Text, 6, 2)
D(1) = Val(Trim(Text1.Text))
D(2) = Now()
D(3) = Format(Str(sinSj1), "0.00")
D(4) = Format(Str(sinSj2), "0.00")
D(5) = Format(Str(sinSj3), "0.00")
D(6) = Format(Str(sinSj4), "0.00")
strcon = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=CSL;Data Source=(LOCAL)"
cn.Open strcon
sqlstr = "select * from CONCENTRATION"
rst.CursorLocation = adUseClient
rst.Open sqlstr, cn, adOpenDynamic, adLockOptimistic '打开记录集
rst.AddNew
Do While Not rst.EOF
For i = 1 To 6
rst.Fields(i).Value = D(i)
Next i
rst.MoveNext
Loop
rst.UpdateBatch '提交，就是写到硬盘的数据库文件
rst.Close '关闭记录集
Set rst = Nothing '释放
cn.Close '关闭连接
Set cn = Nothing '释放
Form7.k = Form7.k + 1
If Form7.k = Form7.ListBox1.ListCount Then Form7.k = 0
End If
MSComm1.InBufferCount = 0
Case Else
End Select
flg = True
DoEvents
End Sub
[解决办法]
出错的时候debug.print一下ubound(InByte)，应该小于9
[解决办法]
与多台下位机通信，个人认为最好采用轮询的方式来实现，结构如下：
Option Explicit
Dim intCommCount As Integer
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Sub Form_Load()
MSComm1.RThreshold = 0 '此处必须设定为0，避免触发OnComm事件
End Sub
'通过变更intCommCount，来指定通信仪表，0～11分别对应下位机1～12，与其下位机地址对应
Private Sub Timer1_Timer()
Dim lngP As Long
lngP = GetTickCount
MSComm1.Output = intCommCount指定的仪表的通信命令
Do
DoEvents
'接收处理MComm1.Input
Loop Until (GetTickCount - lngP) > 40 Or 通信返回结束字符被接收到
intCommCount = (intCommCount + 1) Mod 12 '更新通信指针，以便下一次通信下一个仪表
End Sub
