蠕动泵驱动程序编写受阻，请高手帮忙，非常感谢
某泵驱动程序撰写，如题，本人菜鸟、粘贴很多、bug很多，程序目前输出指令似乎正确，但是苦于无法实现对泵的驱动，已打包——详见https://down.bccn.net/818.html，求高手指点！谢过~~ ps：刚注册，一共可用分20分，没法给更多了……Public Function DelBlank(SearchString As String)
DelBlank = Replace(SearchString, Chr(32), "")
End Function
Sub sendzhenstr(zhen As String) '字符串式输出
Dim tem As String
Dim tem1 As Variant
Dim sendstr As String
Dim OutBuffer() As String
Dim OutBuffer1() As Byte
Dim fcs As Byte
'Debug.Print zhen,
LenOfText = Len(zhen) \ 2
ReDim OutBuffer(LenOfText)
ReDim OutBuffer1(LenOfText)
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
OutBuffer(0) = "E9"
q = 1: fcs = 0
For e = 3 To Len(zhen) Step 2
tem = Mid(zhen, e, 2)
If tem = "E9" Then
tem = "E8": OutBuffer(q) = tem: OutBuffer(q + 1) = "00":: q = q + 1: ReDim OutBuffer(LenOfText + 1)
ElseIf tem = "E8" Then tem = "E8": OutBuffer(q) = tem: OutBuffer(q + 1) = "01": q = q + 1: ReDim OutBuffer(LenOfText + 1)
Else: OutBuffer(q) = tem
End If
q = q + 1
Next
OutBuffer1(0) = "&HE9"
q = 1: fcs = 0
For e = 3 To Len(zhen) Step 2
tem1 = Mid(zhen, e, 2)
If tem1 = "E9" Then
tem1 = "E8": OutBuffer1(q) = "&H" & tem1: OutBuffer1(q + 1) = "&H00": fcs = fcs Xor OutBuffer1(q) Xor OutBuffer1(q + 1): q = q + 1: ReDim OutBuffer1(LenOfText + 1)
ElseIf tem1 = "E8" Then tem1 = "E8": OutBuffer1(q) = "&H" & tem1: OutBuffer1(q + 1) = "&H01": fcs = fcs Xor OutBuffer1(q) Xor OutBuffer1(q + 1): q = q + 1: ReDim OutBuffer1(LenOfText + 1)
Else: OutBuffer1(q) = "&H" & tem1: fcs = fcs Xor OutBuffer1(q)
End If
'Debug.Print "&H" & tem; fcs
q = q + 1
Next
Print fcs
OutBuffer(q) = Hex(fcs)
Print OutBuffer(q)
For i = 0 To q
sendstr = sendstr & OutBuffer(i)
Next i
sendstr = DelBlank(sendstr)
Print sendstr
MSComm1.Output = sendstr
End Sub
Sub sendzhen16(zhen As String) '16进制输出？
Dim tem As Variant
Dim OutBuffer() As Byte
Dim fcs As Byte
'Debug.Print zhen,
LenOfText = Len(zhen) \ 2
ReDim OutBuffer(LenOfText)
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
OutBuffer(0) = "&HE9"
q = 1: fcs = 0
For e = 3 To Len(zhen) Step 2
tem = Mid(zhen, e, 2)
If tem = "E9" Then
tem = "E8": OutBuffer(q) = "&H" & tem: OutBuffer(q + 1) = "&H00": fcs = fcs Xor OutBuffer(q) Xor OutBuffer(q + 1): q = q + 1: ReDim OutBuffer(LenOfText + 1)
ElseIf tem = "E8" Then tem = "E8": OutBuffer(q) = "&H" & tem: OutBuffer(q + 1) = "&H01": fcs = fcs Xor OutBuffer(q) Xor OutBuffer(q + 1): q = q + 1: ReDim OutBuffer(LenOfText + 1)
Else: OutBuffer(q) = "&H" & tem: fcs = fcs Xor OutBuffer(q)
End If
'Debug.Print "&H" & tem; fcs
q = q + 1
Next
OutBuffer(q) = fcs
MSComm1.Output = OutBuffer
End Sub
Sub sendzhen(zhen As String) '2进制输出？
Dim tem As Variant
Dim OutBuffer() As Byte
Dim fcs As Byte
'Debug.Print zhen,
LenOfText = Len(zhen) \ 2
ReDim OutBuffer(LenOfText)
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
OutBuffer(0) = Val("&HE9")
q = 1: fcs = 0
For e = 3 To Len(zhen) Step 2
tem = Mid(zhen, e, 2)
If tem = "E9" Then
tem = "E8": OutBuffer(q) = Val("&H" & tem): OutBuffer(q + 1) = Val("&H00"): fcs = fcs Xor OutBuffer(q) Xor OutBuffer(q + 1): q = q + 1: ReDim OutBuffer(LenOfText + 1)
ElseIf tem = "E8" Then tem = "E8": OutBuffer(q) = Val("&H" & tem): OutBuffer(q + 1) = Val("&H01"): fcs = fcs Xor OutBuffer(q) Xor OutBuffer(q + 1): q = q + 1: ReDim OutBuffer(LenOfText + 1)
Else: OutBuffer(q) = Val("&H" & tem): fcs = fcs Xor OutBuffer(q)
End If
' Debug.Print Val("&H" & tem); fcs
q = q + 1
Next
OutBuffer(q) = fcs
MSComm1.Output = OutBuffer
End Sub
Private Sub Command1_Click() '全选
For i = 1 To 12
Check1(i).Value = 1
Next
End Sub
Private Sub Command2_Click() '全不选
For i = 1 To 12
Check1(i).Value = 0
Next
End Sub
Private Sub Command3_Click() 'main{……}发送数据
Dim e As Integer
Dim q As Integer
Dim i As Integer
Dim a As String
Dim b As String
Dim c As String
Dim LenOfText As Integer
Dim addr(1 To 31) As String
Dim lenpdu(1 To 31) As String
Dim pdu(1 To 31) As String
Dim zhen(1 To 31) As String
If MSComm1.PortOpen = 0 Then
If Combo3.Text = "选择端口" Then
MsgBox ("请选择端口")
Else
= Val(Right(Combo3.Text, 1))
MSComm1.Settings = "1200,n,8,1" '波特率为1200，偶检验，8位数据，1位停止位
MSComm1.InputMode = comInputModeBinary
MSComm1.RThreshold = 1 '串口每收到1字节的数据，即产生接收中断
MSComm1.InBufferSize = 100
MSComm1.OutBufferSize = 1024
MSComm1.SThreshold = 1
MSComm1.InBufferCount = 0
MSComm1.OutBufferCount = 0
MSComm1.PortOpen = True '打开串口
End If
End If
t = Val(text1.Text) - 1
Timer1.Enabled = -1
a = Hex(Val(Combo1.Text) * 10) '转速
If Len(a) = 3 Then a = "0" + a
If Len(a) = 2 Then a = "00" + a
If Len(a) = 1 Then a = "000" + a
If Combo2.Text = "正常运行" Then b = "0" Else b = "1" '全速与否
If Option1.Value Then c = "01" Else c = "00" '正反转
q = 1
For i = 1 To 12
If Check1(i) = 0 Then Exit For
q = q + 1
Next
If q < 12 Then
For i = 1 To 12
addr(i) = "0" & Hex(i)
If Combo4.Text = "设置运行参数" Then
pdu(i) = "574A" & a & "0" & Str(b * 2 + Str(Check1(i).Value)) & c 'pdu
pdu(i) = DelBlank(pdu(i))
End If
If Combo4.Text = "读取运行参数" Then
pdu(i) = "524A" 'pdu
End If
If Combo4.Text = "设置设备地址" Then
pdu(i) = "574944" & Text2.Text 'pdu
pdu(i) = DelBlank(pdu(i))
End If
If Combo4.Text = "读取设备地址" Then
pdu(i) = "524944" 'pdu
End If
lenpdu(i) = Str(Len(pdu(i)) / 2) 'len
zhen(i) = "E9" & addr(i) & "0" & lenpdu(i) & pdu(i)
zhen(i) = DelBlank(zhen(i))
' Debug.Print zhen(i)
' Call sendzhenstr(zhen(i))
Call sendzhen16(zhen(i))
' Call sendzhen(zhen(i))
Next
Else
For i = 1 To 12
addr(i) = "1F"
If Combo4.Text = "设置运行参数" Then
pdu(i) = "574A" & a & "0" & Str(b * 2 + Str(Check1(i).Value)) & c 'pdu
pdu(i) = DelBlank(pdu(i))
End If
If Combo4.Text = "设置设备地址" Then
pdu(i) = "574944" & Text2.Text 'pdu
pdu(i) = DelBlank(pdu(i))
End If
lenpdu(i) = Str(Len(pdu(i)) / 2) 'len
zhen(i) = "E9" & addr(i) & "0" & lenpdu(i) & pdu(i)
zhen(i) = DelBlank(zhen(i))
' Debug.Print zhen(i)
Next
'Call sendzhenstr(zhen(1))
Call sendzhen16(zhen(1))
'Call sendzhen(zhen(1))
End If
End Sub
Private Sub Command4_Click() '复位/停止
Form1.Cls
For i = 1 To 12
Check1(i).Value = 0
Next
Timer1.Enabled = 0
'Call sendzhenstr("E9 1F 06 57 4A 00 0A 00 01")
Call sendzhen16("E9 1F 06 57 4A 00 0A 00 01")
'Call sendzhen("E9 1F 06 57 4A 00 0A 00 01")
If MSComm1.PortOpen = -1 Then MSComm1.PortOpen = 0
End Sub
'Private Sub Command5_Click() '多字节接收
' = Val(Right(Combo3.Text, 1))
'MSComm1.Settings = "1200,n,8,1" '波特率为1200，偶检验，8位数据，1位停止位
'MSComm1.InputMode = comInputModeBinary
'MSComm1.RThreshold = 10 '串口每收到10字节的数据，即产生接收中断
'MSComm1.InBufferSize = 100
'MSComm1.OutBufferSize = 1024
'MSComm1.SThreshold = 0
'MSComm1.InBufferCount = 0
'MSComm1.OutBufferCount = 0
'MSComm1.PortOpen = True '打开串口
' Dim sendSj(7) As Byte
' Dim i As Long
' sendSj(0) = &HE9
' sendSj(1) = &HE1
' sendSj(2) = &H4
' sendSj(3) = &H43
' sendSj(4) = &H57
' sendSj(5) = &H58
' sendSj(6) = &H31
' sendSj(7) = sendSj(0) Xor sendSj(1) Xor sendSj(2) Xor sendSj(3) Xor sendSj(4) Xor sendSj(5) Xor sendSj(6)
' For i = 1 To 7
' Print sendSj(i)
' Next
'
' MSComm1.Output = sendSj
'End Sub
'Private Sub CommandButton1_Click()
'
'Dim BytesReceived() As Byte
'Dim buffer As String
'Dim HData As String
'Dim i As Integer
'Dim j As Integer
'Dim f As Integer
'Dim x As Integer
'Dim y As Integer
'Dim z As Integer
'Dim w As Integer
'
'Select Case
'Case comEvReceive '接收十六进制数据。并以十六进制显示
'MSComm1.InputLen = 0
'buffer = MSComm1.Input '接收数据至字符串中
'BytesReceived() = buffer '将数据转入Byte数组中
'For i = 0 To UBound(BytesReceived) '显示结果以十六进制显示
'If Hex(BytesReceived(i)) = "E9" Then f = i
'If Hex(BytesReceived(i)) = "e8" Then
' If BytesReceived1(i + 1) = 1 Then
' BytesReceived(i) = "E9"
' For j = i + 1 To UBound(BytesReceived)
' BytesReceived(j) = BytesReceived(j + 1)
' Next j
' End If
'
' If BytesReceived1(i + 1) = 0 Then
' BytesReceived(i) = "E8"
' For j = i + 1 To UBound(BytesReceived)
' BytesReceived(j) = BytesReceived(j + 1)
' Next j
' End If
'
'
'If Len(Hex(BytesReceived(i))) = 1 Then
'HData = HData & "0" & Hex(BytesReceived(i))
'Else
'HData = HData & Hex(BytesReceived(i))
'
'End If
'Next
'
'
'End Select
'x = Val("&h" & Hex(BytesReceived(f + 1))) '地址
'If Val("&h" & Hex(BytesReceived(f + 2))) = 6 Then
'y = Val("&h" & Hex(BytesReceived(f + 5)) & Hex(BytesReceived(f + 5))) / 10
'z = Val("&h" & Hex(BytesReceived(f + 7)))
'w = Val("&h" & Hex(BytesReceived(f + 8)))
'Select Case w
'w = 1
'If z = 0 Or z = 2 Then Text3.Text = x & "号泵未工作"
'If z = 1 Then Text3.Text = x & "号泵正常运行+" & y & "r/min"
'If z = 3 Then Text3.Text = x & "号泵全速运行+" & y & "r/min"
'w = 0
'If z = 0 Or z = 2 Then Text3.Text = x & "号泵未工作"
'If z = 1 Then Text3.Text = x & "号泵正常运行-" & y & "r/min"
'If z = 3 Then Text3.Text = x & "号泵全速运行-" & y & "r/min"
'
'
'Text2.Text = HData
'
'
'
''最后将结果后入Text2中
'MSComm1.OutBufferCount = 0 '清除发送缓冲区
'MSComm1.InBufferCount = 0 '清除接收缓冲区
'MSComm1.PortOpen = False
'
'End Sub
Private Sub Form_Load()
' = 2 '我用的是USB转串口，设备管理器中看到端口号为4
Timer1.Enabled = 0
End Sub
Private Sub MSComm1_OnComm() 'MSComm1.RThreshold = 1
On Error Resume Next
Dim BytesReceived() As Byte
Dim buffer As String
Dim HData As String
Dim i As Integer
Select Case
Case comEvReceive '接收十六进制数据。并以十六进制显示
MSComm1.InputLen = 0
buffer = MSComm1.Input '接收数据至字符串中
BytesReceived() = buffer '将数据转入Byte数组中
For i = 0 To UBound(BytesReceived) '显示结果以十六进制显示
If Len(Hex(BytesReceived(i))) = 1 Then
HData = HData & "0" & Hex(BytesReceived(i))
Else
HData = HData & Hex(BytesReceived(i))
End If
Text2.Text = HData
'最后将结果后入Text2中
MSComm1.OutBufferCount = 0 '清除发送缓冲区
MSComm1.InBufferCount = 0 '清除接收缓冲区
MSComm1.PortOpen = False
Next
End Select
End Sub
Dim t As Integer
Private Sub Timer1_Timer()
t = t - 1
text1.Text = t
If t = 0 Then
For i = 1 To 12
Check1(i).Value = 0
Next
Call sendzhen("E93106574A00000000")
Timer1.Enabled = 0
End If
End Sub
[ 本帖最后由 xxjtse 于 2011-6-20 02:28 编辑 ]
···
