《VB MODBUS实现源码.docx》由会员分享，可在线阅读，更多相关《VB MODBUS实现源码.docx（21页珍藏版）》请在三一办公上搜索。
1、VB MODBUS实现源码Option Explicit Public bln_busy As Boolean Public bln_success As Boolean Public bln_readword As Boolean Public Declare Function timeGetTime Lib winmm.dll As Long Public Sub tran_modbus_order(ByVal byt_slv_id As Byte, ByVal byt_func As Byte, ByVal addr As Long, byt_data As Byte) Dim tran
2、s_byte As Byte Dim i As Integer Dim j As Integer Dim k As Integer Dim Index As Integer Dim CRC As Byte Dim temp As Integer Dim lenth As Integer Dim lenth1 As Integer Select Case byt_func Case 1 ReDim trans_byte(7) As Byte trans_byte(0) = byt_slv_id trans_byte(1) = 1 trans_byte(2) = (addr - 1) 256 tr
3、ans_byte(3) = (addr - 1) Mod 256 trans_byte(4) = 0 trans_byte(5) = byt_data(0) CRC = CRC16(trans_byte) trans_byte(6) = CRC(0) trans_byte(7) = CRC(1) Case 3 ReDim trans_byte(7) As Byte trans_byte(0) = byt_slv_id trans_byte(1) = 3 trans_byte(2) = (addr - 1) 256 trans_byte(3) = (addr - 1) Mod 256 trans
4、_byte(4) = 0 trans_byte(5) = byt_data(0) CRC = CRC16(trans_byte) trans_byte(6) = CRC(0) trans_byte(7) = CRC(1) Case 6 ReDim trans_byte(7) As Byte trans_byte(0) = byt_slv_id trans_byte(1) = 6 trans_byte(2) = (addr - 1) 256 trans_byte(3) = (addr - 1) Mod 256 trans_byte(4) = byt_data(0) trans_byte(5) =
5、 byt_data(1) CRC = CRC16(trans_byte) trans_byte(6) = CRC(0) trans_byte(7) = CRC(1) Case 15 lenth = UBound(byt_data) + 1 lenth1 = (lenth - 1) 8 + 1 ReDim trans_byte(8 + lenth1) trans_byte(0) = byt_slv_id trans_byte(1) = &HF trans_byte(2) = (addr - 1) 256 trans_byte(3) = (addr - 1) Mod 256 trans_byte(
6、4) = 0 trans_byte(5) = lenth trans_byte(6) = lenth1 k = 0 Index = 7 temp = 0 For i = 1 To lenth temp = temp + byt_data(i - 1) * (2 k) If (i Mod 8 = 0) Then trans_byte(Index) = CByte(temp) Index = Index + 1 temp = 0 k = 0 End If k = k + 1 Next i trans_byte(Index) = CByte(temp) CRC = CRC16(trans_byte)
7、 trans_byte(7 + lenth1) = CRC(0) trans_byte(8 + lenth1) = CRC(1) Case 16 lenth = UBound(byt_data) + 1 ReDim trans_byte(8 + lenth) trans_byte(0) = byt_slv_id trans_byte(1) = &H10 trans_byte(2) = (addr - 1) 256 trans_byte(3) = (addr - 1) Mod 256 trans_byte(4) = 0 trans_byte(5) = lenth 2 trans_byte(6)
8、= lenth For i = 0 To lenth - 1 trans_byte(7 + i) = byt_data(i) Next i CRC = CRC16(trans_byte) trans_byte(7 + lenth) = CRC(0) trans_byte(8 + lenth) = CRC(1) End Select frm_modbus.Output = trans_byte Dim ts_i As Integer Dim ts_str As String ts_str = send: For ts_i = 0 To UBound(trans_byte) ts_str = ts
9、_str + CStr(Hex(trans_byte(ts_i) + Next ts_i frm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text If (Len(frm_main.Txt_msg.Text) 30000) Then frm_main.Txt_msg.Text = End If frm_modbus.OutBufferCount = 0 End Sub Function CRC16(data As Byte) As String Dim CRC16Lo As Byte, CRC16Hi
10、As Byte CRC寄存器 Dim CL As Byte, CH As Byte 多项式码&HA001 Dim SaveHi As Byte, SaveLo As Byte Dim i As Integer Dim flag As Integer On Error GoTo wrong CRC16Lo = &HFF CRC16Hi = &HFF CL = &H1 CH = &HA0 For i = 0 To UBound(data) - 2 DoEvents DoEvents DoEvents CRC16Lo = CRC16Lo Xor data(i) 每一个数据与CRC寄存器进行异或 Fo
11、r flag = 0 To 7 SaveHi = CRC16Hi SaveLo = CRC16Lo CRC16Hi = CRC16Hi 2 高位右移一位 CRC16Lo = CRC16Lo 2 低位右移一位 If (SaveHi And &H1) = &H1) Then 如果高位字节最后一位为1 CRC16Lo = CRC16Lo Or &H80 则低位字节右移后前面补1 End If 否则自动补0 If (SaveLo And &H1) = &H1) Then 如果LSB为1，则与多项式码进行异或 CRC16Hi = CRC16Hi Xor CH CRC16Lo = CRC16Lo Xor
12、CL End If Next flag Next i Dim ReturnData(1) As Byte ReturnData(0) = CRC16Lo CRC高位 ReturnData(1) = CRC16Hi CRC低位 CRC16 = ReturnData Exit Function wrong: errprocess CRC16 End Function Public Function readcoils(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByVal int_time As Integer, B
13、yRef ret_val As Byte) As Integer Dim byt_data(0) As Byte Dim lngStartTimer As Long Dim lnginval As Long Dim bln_cx As Boolean Dim ret_byte As Byte tm_delay.Enabled = False byt_data(0) = lenth Do Until bln_busy = False Or (Abs(timeGetTime - lng_time 200) DoEvents Loop bln_busy = True frm_modbus.InBuf
14、ferCount = 0 tran_modbus_order slv_id, 1, addr, byt_data lngStartTimer = timeGetTime lnginval = timeGetTime bln_success = False Dim r_input As Byte Dim i As Integer Static intCount As Integer Do Until Abs(timeGetTime - lngStartTimer) int_time Or bln_success DoEvents DoEvents DoEvents DoEvents lnginv
15、al = timeGetTime If (Abs(timeGetTime - lnginval) 8) Then If (intCount frm_modbus.InBufferCount Or intCount = 0) Then intCount = frm_modbus.InBufferCount Else Timer1.Enabled = False ReDim r_input(1024) As Byte frm_modbus.InputLen = 0 Input_Len = frm_M_modbus.InBufferCount r_input = frm_modbus.Input f
16、rm_modbus.InBufferCount = 0 For i = 0 To UBound(r_input) Debug.Print r_input(i) Text1.Text = Text1.Text & CStr(Hex(r_input(i) + Next i intCount = 0 bln_success = True End If lnginval = timeGetTime End If Loop If (bln_success) Then Dim lenth1 As Integer readcoils = 0 ret_byte = r_input lenth1 = (lent
17、h - 1) 8 + 1 ReDim ret_val(lenth1 - 1) For i = 1 To lenth1 ret_val(i - 1) = ret_byte(2 + i) Next i intCount = 0 Else intCount = 0 readcoils = 1 End If bln_busy = False tm_delay.Enabled = True End Function Public Function writecoils(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByRef
18、 byt_data As Byte, ByVal int_time As Integer) As Integer Dim lngStartTimer As Long Dim lnginval As Long Dim bln_cx As Boolean tm_delay.Enabled = False Do Until bln_busy = False Or (Abs(timeGetTime - lng_time 200) DoEvents DoEvents DoEvents DoEvents DoEvents Loop bln_busy = True frm_modbus.InBufferCo
19、unt = 0 tran_modbus_order slv_id, 15, addr, byt_data lngStartTimer = timeGetTime lnginval = timeGetTime bln_success = False Dim r_input As Byte Dim i As Integer Static intCount As Integer Do Until Abs(timeGetTime - lngStartTimer) int_time Or bln_success DoEvents DoEvents DoEvents DoEvents DoEvents D
20、oEvents DoEvents lnginval = timeGetTime If (Abs(timeGetTime - lnginval) 8) Then If (intCount frm_modbus.InBufferCount Or intCount = 0) Then intCount = frm_modbus.InBufferCount Else frm_modbus.InputLen = 0 Input_Len = frm_M_modbus.InBufferCount r_input = frm_modbus.Input frm_modbus.InBufferCount = 0
21、For i = 0 To UBound(r_input) Debug.Print r_input(i) Next i intCount = 0 bln_success = True End If lnginval = timeGetTime End If Loop If (bln_success) Then writecoils = 0 intCount = 0 Else intCount = 0 writecoils = 1 End If bln_busy = False tm_delay.Enabled = True End Function Public Function readwor
22、ds(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByVal int_time As Integer, ByRef ret_val As Long) As Integer Dim lenth1 As Integer Dim lenth2 As Integer Dim ret_val1 As Long Dim ret_val2 As Long Dim addr1 As Long Dim addr2 As Long Dim ret As Integer If (lenth 100) Then lenth1 = 100
23、 lenth2 = lenth - 100 addr1 = addr addr2 = addr + 100 ret = readwords1(slv_id, addr1, lenth1, int_time, ret_val1) If (ret 0) Then readwords = ret Exit Function End If ret = readwords1(slv_id, addr2, lenth2, int_time, ret_val2) If (ret 0) Then readwords = ret Exit Function End If ReDim ret_val(lenth
24、- 1) As Long Dim i As Integer For i = 0 To 99 ret_val(i) = ret_val1(i) Next i For i = 100 To lenth - 1 ret_val(i) = ret_val2(i - 100) Next i readwords = ret Else readwords = readwords1(slv_id, addr, lenth, int_time, ret_val) End If End Function Public Function readwords1(ByVal slv_id As Byte, ByVal
25、addr As Long, ByVal lenth As Byte, ByVal int_time As Integer, ByRef ret_val As Long) As Integer Dim byt_data(0) As Byte Dim lngStartTimer As Long Dim ret_byte As Byte Dim r_input As Byte Dim CRC As Byte Dim intCount As Integer Dim i As Integer byt_data(0) = lenth Do Until bln_busy = False Or (Abs(ti
26、meGetTime - lng_time 200) DoEvents DoEvents Loop bln_busy = True frm_modbus.InBufferCount = 0 tran_modbus_order slv_id, 3, addr, byt_data lngStartTimer = timeGetTime bln_success = False Do Until Abs(timeGetTime - lngStartTimer) int_time Or bln_success DoEvents DoEvents DoEvents intCount = frm_modbus
27、.InBufferCount If intCount = CInt(byt_data(0) * 2 + 5) Then bln_success = True frm_modbus.InputLen = 0 r_input = frm_modbus.Input frm_modbus.InBufferCount = 0 End If Loop frm_Main.Label2.Caption = timeGetTime - lngStartTimer + CLng(frm_Main.Label2.Caption) If bln_success And intCount = CInt(byt_data
28、(0) * 2 + 5) Then CRC = CRC16(r_input) If CRC(0) = r_input(UBound(r_input) - 1) And CRC(1) = r_input(UBound(r_input) Then ret_byte = r_input ReDim ret_val(lenth - 1) As Long Dim byt(3) As Byte For i = 0 To lenth - 1 ret_val(i) = CLng(ret_byte(i * 2 + 3) * 256 + ret_byte(i * 2 + 4) If (ret_val(i) 327
29、67) Then ret_val(i) = ret_val(i) - 65536 End If Next i readwords1 = 0 通讯成功 Else readwords1 = 2 通讯错误 End If Else If intCount 0 Then readwords1 = 2 通讯错误 r_input = frm_modbus.Input Else readwords1 = 1 通讯失败 End If bln_busy = False End If Dim ts_i As Integer Dim ts_str As String If (intCount 0) Then ts_s
30、tr = receive: For ts_i = 0 To UBound(r_input) ts_str = ts_str + CStr(Hex(r_input(ts_i) + Next ts_i frm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text Else ts_str = no receive: frm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text End If End Function Publi
31、c Function writewords(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByRef lng_data As Long, ByVal int_time As Integer) As Integer Dim ret As Integer Dim lenth1 As Integer Dim lenth2 As Integer Dim addr1 As Integer Dim addr2 As Integer Dim lng_data1 As Long Dim lng_data2 As Long Dim
32、i As Integer If (lenth 100) Then ReDim lng_data1(99) ReDim lng_data2(lenth - 100 - 1) For i = 0 To 99 lng_data1(i) = lng_data(i) Next i For i = 100 To lenth - 1 lng_data2(i - 100) = lng_data(i) Next i addr1 = addr addr2 = addr + 100 lenth1 = 100 lenth2 = lenth - 100 ret = writewords1(slv_id, addr1,
33、lenth1, lng_data1, int_time) If (ret 0) Then writewords = ret Exit Function End If ret = writewords1(slv_id, addr2, lenth2, lng_data2, int_time) If (ret 0) Then writewords = ret Exit Function End If Else writewords = writewords1(slv_id, addr, lenth, lng_data, int_time) End If End Function Public Fun
34、ction writewords1(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByRef lng_data As Long, ByVal int_time As Integer) On Error GoTo wrong Dim lngStartTimer As Long Dim lnginval As Long Dim bln_cx As Boolean Dim byt_data As Byte Dim r_input As Byte Dim CRC As Byte Dim i As Integer ReDim
35、 byt_data(lenth * 2 - 1) As Byte For i = 0 To lenth - 1 byt_data(2 * i) = lng_data(i) 256 byt_data(2 * i + 1) = lng_data(i) Mod 256 Next i Do Until bln_busy = False Or (Abs(timeGetTime - lng_time 200) DoEvents DoEvents DoEvents DoEvents DoEvents Loop bln_busy = True frm_modbus.InBufferCount = 0 If (
36、lenth 1) Then tran_modbus_order slv_id, 16, addr, byt_data Else tran_modbus_order slv_id, 6, addr, byt_data End If lngStartTimer = timeGetTime bln_success = False Dim intCount As Integer Do Until Abs(timeGetTime - lngStartTimer) int_time Or bln_success DoEvents DoEvents DoEvents DoEvents DoEvents Do
37、Events intCount = frm_modbus.InBufferCount If intCount = 8 Then bln_success = True frm_modbus.InputLen = 0 r_input = frm_modbus.Input frm_modbus.InBufferCount = 0 End If Loop If bln_success And intCount = 8 Then CRC = CRC16(r_input) If CRC(0) = r_input(UBound(r_input) - 1) And CRC(1) = r_input(UBound(r_input) Then writewords1 = 0 通讯成功 Else writewords1 = 2 通讯错误 End If ElseIf intCount 0 Then writewords1 = 2 通讯错
