VBMODBUS实现源码

《VBMODBUS实现源码》由会员分享，可在线阅读，更多相关《VBMODBUS实现源码（15页珍藏版）》请在装配图网上搜索。

1、Option ExplicitPublic bln_busy As BooleanPublic bln_success As BooleanPublic bln_readword As BooleanPublic Declare Function timeGetTime Lib winmm.dll () As LongPublic Sub tran_modbus_order(ByVal byt_slv_id As Byte, ByVal byt_func As Byte, ByVal addr As Long, byt_data() As Byte)Dim trans_byte() As By

2、teDim i As IntegerDim j As IntegerDim k As IntegerDim Index As IntegerDim CRC() As ByteDim temp As IntegerDim lenth As IntegerDim lenth1 As IntegerSelect Case byt_funcCase 1ReDim trans_byte(7) As Bytetrans_byte(0) = byt_slv_id trans_byte(1) = 1trans_byte(2) = (addr - 1) 256trans_byte(3) = (addr - 1)

3、 Mod 256 trans_byte(4) = 0trans_byte(5) = byt_data(0)CRC = CRC16(trans_byte)trans_byte(6) = CRC(0)trans_byte(7) = CRC(1)Case 3ReDim trans_byte(7) As Bytetrans_byte(0) = byt_slv_id trans_byte(1) = 3trans_byte(2) = (addr - 1) 256trans_byte(3) = (addr - 1) Mod 256 trans_byte(4) = 0trans_byte(5) = byt_d

4、ata(0)CRC = CRC16(trans_byte) trans_byte(6) = CRC(0) trans_byte(7) = CRC(1)Case 6ReDim trans_byte(7) As Byte trans_byte(0) = byt_slv_idtrans_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) = byt_data(1) CRC = CRC16(trans_byte) t

5、rans_byte(6) = CRC(0) trans_byte(7) = CRC(1)Case 15lenth = 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(4) = 0 trans_byte(5) = lenth trans_byte(

6、6) = lenth1 k = 0 Index = 7 temp = 0For i = 1 To lenthtemp = temp + byt_data(i - 1) * (2 A k)If (i Mod 8 = 0) Thentrans_byte(Index) = CByte(temp) Index = Index + 1 temp = 0 k = 0End Ifk = k + 1Next itrans_byte(Index) = CByte(temp) CRC = CRC16(trans_byte) trans_byte(7 + lenth1) = CRC(0) trans_byte(8

7、+ lenth1) = CRC(1)Case 16lenth = 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) = lenth For i = 0 To lenth - 1trans_byte(7 + i)

8、= byt_data(i)Next iCRC = CRC16(trans_byte) trans_byte(7 + lenth) = CRC(0) trans_byte(8 + lenth) = CRC(1) End Selectfrm_modbus.Output = trans_byte Dim ts_i As IntegerDim ts_str As String ts_str = send:For ts_i = 0 To UBound(trans_byte)ts_str = ts_str + CStr(Hex(trans_byte(ts_i) + Next ts_ifrm_main.Tx

9、t_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text If (Len(frm_main.Txt_msg.Text) 30000) Thenfrm_main.Txt_msg.Text = End If frm_modbus.OutBufferCount = 0End SubFunction CRC16(data() As Byte) As StringDim CRC16Lo As Byte, CRC16Hi As Byte CRC 寄存器Dim CL As Byte, CH As Byte多项式码 &HA001Dim Sa

10、veHi As Byte, SaveLo As ByteDim i As IntegerDim flag As IntegerOn Error GoTo wrong CRC16Lo = &HFF CRC16Hi = &HFF CL = &H1CH = &HA0For i = 0 To UBound(data) - 2DoEventsDoEventsDoEventsCRC16Lo = CRC16Lo Xor data(i) 每一个数据与 CRC 寄存器进行异或高位右移一位低位右移一位如果高位字节最后一位为 1则低位字节右移后前面补 1否则自动补 0如果 LSB 为 1，则与多项式码进行异或CRC

11、 高位CRC 低位For flag = 0 To 7 SaveHi = CRC16Hi SaveLo = CRC16Lo CRC16Hi = CRC16Hi 2 CRC16Lo = CRC16Lo 2If (SaveHi And &H1) = &H1) Then CRC16Lo = CRC16Lo Or &H80 End IfIf (SaveLo And &H1) = &H1) Then CRC16Hi = CRC16Hi Xor CH CRC16Lo = CRC16Lo Xor CLEnd IfNext flagNext iDim ReturnData(1) As Byte ReturnDa

12、ta(0) = CRC16Lo ReturnData(1) = CRC16HiCRC16 = ReturnDataExit Functionwrong: errprocess CRC16End FunctionPublic Function readcoils(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByVal int_time As Integer, ByRef ret_val() As Byte) As IntegerDim byt_data(0) As ByteDim lngStartTimer As

13、LongDim lnginval As LongDim bln_cx As BooleanDim ret_byte() As Bytetm_delay.Enabled = False byt_data(0) = lenthDo Until bln_busy = False Or (Abs(timeGetTime - lng_time 200) DoEventsLoopbln_busy = True frm_modbus.InBufferCount = 0 tran_modbus_order slv_id, 1, addr, byt_data lngStartTimer = timeGetTim

14、e lnginval = timeGetTime() bln_success = FalseDim r_input() As ByteDim i As IntegerStatic intCount As IntegerDo Until Abs(timeGetTime - lngStartTimer) int_time Or bln_successDoEventsDoEventsDoEventsDoEventslnginval = timeGetTime()If (Abs(timeGetTime - lnginval) 8) ThenII0) ThenIf (intCount frm_modbu

15、s.InBufferCount Or intCount intCount = frm_modbus.InBufferCountElseTimer1.Enabled = FalseReDim r_input(1024) As Byte frm_modbus.InputLen = 0 Input_Len = frm_M_modbus.InBufferCount r_input = frm_modbus.Input frm_modbus.InBufferCount = 0 For i = 0 To UBound(r_input)Debug.Print r_input(i)Text1.Text = T

16、ext1.Text & CStr(Hex(r_input(i) + Next iintCount = 0bln_success = TrueEnd Iflnginval = timeGetTime()End IfLoopIf (bln_success) ThenDim lenth1 As Integerreadcoils = 0 ret_byte = r_input lenth1 = (lenth - 1) 8 + 1 ReDim ret_val(lenth1 - 1) For i = 1 To lenth1ret_val(i - 1) = ret_byte(2 + i)Next iintCo

17、unt = 0ElseintCount = 0 readcoils = 1End Ifbln_busy = Falsetm_delay.Enabled = TrueEnd FunctionPublic Function writecoils(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByRef byt_data() As Byte, ByVal int_time As Integer) As IntegerDim lngStartTimer As LongDim lnginval As LongDim bln_

18、cx As Booleantm_delay.Enabled = FalseDo Until bln_busy = False Or (Abs(timeGetTime - lng_time 200) DoEvents DoEvents DoEvents DoEvents DoEventsLoopbln_busy = True frm_modbus.InBufferCount = 0 tran_modbus_order slv_id, 15, addr, byt_data lngStartTimer = timeGetTime lnginval = timeGetTime() bln_succes

19、s = FalseDim r_input() As ByteDim i As IntegerStatic intCount As IntegerDo Until Abs(timeGetTime - lngStartTimer) int_time Or bln_successDoEventsDoEventsDoEventsDoEventsDoEventsDoEventsDoEventslnginval = timeGetTime()If (Abs(timeGetTime - lnginval) 8) ThenIf (intCount frm_modbus.InBufferCount Or int

20、Count = 0) Then intCount = frm_modbus.InBufferCountElse frm_modbus.InputLen = 0 Input_Len = frm_M_modbus.InBufferCount r_input = frm_modbus.Input frm_modbus.InBufferCount = 0 For i = 0 To UBound(r_input)Debug.Print r_input(i)Next i intCount = 0 bln_success = TrueEnd Iflnginval = timeGetTime()End IfL

21、oopIf (bln_success) Thenwritecoils = 0intCount = 0ElseintCount = 0 writecoils = 1End Ifbln_busy = Falsetm_delay.Enabled = TrueEnd FunctionPublic Function readwords(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByVal int_time As Integer, ByRef ret_val() As Long) As IntegerDim lenth1

22、As IntegerDim lenth2 As IntegerDim ret_val1() As LongDim ret_val2() As LongDim addr1 As LongDim addr2 As LongDim ret As IntegerIf (lenth 100) Thenlenth1 = 100lenth2 = lenth - 100addr1 = addraddr2 = addr + 100ret = readwords1(slv_id, addr1, lenth1, int_time, ret_val1)If (ret 0) Then readwords = ret E

23、xit FunctionEnd Ifret = readwords1(slv_id, addr2, lenth2, int_time, ret_val2)If (ret 0) Then readwords = ret Exit FunctionEnd IfReDim ret_val(lenth - 1) As LongDim i As IntegerFor i = 0 To 99ret_val(i) = ret_val1(i)Next iFor i = 100 To lenth - 1ret_val(i) = ret_val2(i - 100)Next i readwords = retEls

24、ereadwords = readwords1(slv_id, addr, lenth, int_time, ret_val)End IfEnd FunctionPublic Function readwords1(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByVal int_time As Integer, ByRef ret_val() As Long) As IntegerDim byt_data(0) As ByteDim lngStartTimer As LongDim ret_byte() As B

25、yteDim r_input() As ByteDim CRC() As ByteDim intCount As IntegerDim i As Integer byt_data(0) = lenth Do Until bln_busy = False Or (Abs(timeGetTime - lng_time 200) DoEvents DoEventsILoopbln_busy = True frm_modbus.InBufferCount = 0 tran_modbus_order slv_id, 3, addr, byt_data lngStartTimer = timeGetTim

26、e bln_success = FalseDo Until Abs(timeGetTime - lngStartTimer) int_time Or bln_successDoEventsDoEventsDoEventsintCount = frm_modbus.InBufferCountIf intCount = CInt(byt_data(0) * 2 + 5) Then bln_success = True frm_modbus.InputLen = 0r_input = frm_modbus.Input frm_modbus.InBufferCount = 0End IfLoopfrm

27、_Main.Label2.Caption = timeGetTime - lngStartTimer + CLng(frm_Main.Label2.Caption) If bln_success And intCount = CInt(byt_data(0) * 2 + 5) ThenCRC = CRC16(r_input)If CRC(0) = r_input(UBound(r_input) - 1) And CRC(1) = r_input(UBound(r_input) Then ret_byte = r_inputReDim ret_val(lenth - 1) As LongDim

28、byt(3) As ByteFor i = 0 To lenth - 1 ret_val(i) = CLng(ret_byte(i * 2 + 3) * 256 + ret_byte(i * 2 + 4) If (ret_val(i) 32767) Then ret_val(i) = ret_val(i) - 65536End IfNext ireadwords1 = 0 通讯成功Elsereadwords1 = 2 通讯错误End IfElseIf intCount 0 Then readwords1 = 2 通讯错误 r_input = frm_modbus.InputElsereadwo

29、rds1 = 1 通讯失败End Ifbln_busy = FalseEnd IfDim ts_i As IntegerDim ts_str As StringIf (intCount 0) Then ts_str = 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.TextElsets_str = no receiv

30、e: frm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.TextEnd IfEnd FunctionPublic 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 IntegerDim ret As IntegerDim lenth1 As IntegerDim lenth2 As

31、 IntegerDim addr1 As IntegerDim addr2 As IntegerDim lng_data1() As LongDim lng_data2() As LongDim i As IntegerIf (lenth 100) ThenReDim lng_data1(99)ReDim lng_data2(lenth - 100 - 1)For i = 0 To 99lng_data1(i) = lng_data(i)Next iFor i = 100 To lenth - 1lng_data2(i - 100) = lng_data(i)Next iaddr1 = add

32、raddr2 = addr + 100lenth1 = 100lenth2 = lenth - 100ret = writewords1(slv_id, addr1, lenth1, lng_data1, int_time)If (ret 0) Thenwritewords = retExit FunctionEnd Ifret = writewords1(slv_id, addr2, lenth2, lng_data2, int_time)If (ret 0) Thenwritewords = retExit FunctionEnd IfElsewritewords = writewords

33、1(slv_id, addr, lenth, lng_data, int_time)End IfEnd FunctionPublic Function 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 wrongDim lngStartTimer As LongDim lnginval As LongDim bln_cx As BooleanDim byt_data

34、() As ByteDim r_input() As ByteDim CRC() As ByteDim i As IntegerReDim byt_data(lenth * 2 - 1) As ByteFor i = 0 To lenth - 1 byt_data(2 * i) = lng_data(i) 256 byt_data(2 * i + 1) = lng_data(i) Mod 256Next iDo Until bln_busy = False Or (Abs(timeGetTime - lng_time 200) DoEvents DoEvents DoEvents DoEven

35、ts DoEventsLoopbln_busy = True frm_modbus.InBufferCount = 0If (lenth 1) Then tran_modbus_order slv_id, 16, addr, byt_dataElse tran_modbus_order slv_id, 6, addr, byt_dataEnd If lngStartTimer = timeGetTime bln_success = FalseDim intCount As IntegerDo Until Abs(timeGetTime - lngStartTimer) int_time Or

36、bln_successDoEventsDoEventsDoEventsDoEventsDoEventsDoEvents intCount = frm_modbus.InBufferCount If intCount = 8 Thenbln_success = Truefrm_modbus.InputLen = 0 r_input = frm_modbus.Input frm_modbus.InBufferCount = 0End IfLoopIf bln_success And intCount = 8 ThenCRC = CRC16(r_input)If CRC(0) = r_input(U

37、Bound(r_input) - 1) And CRC(1) = r_input(UBound(r_input) Thenwritewords1 = 0通讯成功Else writewords1 = 2通讯错误End IfElseIf intCount 0 Thenwritewords1 = 2通讯错误Elsewritewords1 = 1通讯失败End IfIf (Not bln_success And intCount 0) Thenfrm_modbus.InputLen = 0r_input = frm_modbus.Input frm_modbus.InBufferCount = 0En

38、d Ifbln_busy = FalseDim ts_i As IntegerDim ts_str As StringIf (intCount 0) Thents_str = receive:For ts_i = 0 To UBound(r_input)ts_str = ts_str + CStr(Hex(r_input(ts_i) + Next ts_ifrm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text Elsets_str = no receive:frm_main.Txt_msg.Text

39、= ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text End Ifwrong: DoEventsEnd Function读浮点数Public Function readsgls(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByVal int_time As Integer, ByRef ret_val() As Single) As IntegerDim lenth1 As IntegerDim lenth2 As IntegerDim ret_val1() A

40、s SingleDim ret_val2() As SingleDim addr1 As LongDim addr2 As LongDim ret As Integer If (lenth 50) Then lenth1 = 50 lenth2 = lenth - lenth1 addr1 = addr addr2 = addr + 100 ret = readsgls1(slv_id, addr1, lenth1, int_time, ret_val1) If (ret 0) Then readsgls = ret Exit FunctionEnd Ifret = readsgls1(slv

41、_id, addr2, lenth2, int_time, ret_val2)If (ret 0) Then readsgls = ret Exit FunctionEnd IfReDim ret_val(lenth - 1) As SingleDim i As IntegerFor i = 0 To 49 ret_val(i) = ret_val1(i)Next iFor i = 50 To lenth - 1 ret_val(i) = ret_val2(i - 50)Next i readsgls = retElsereadsgls = readsgls1(slv_id, addr, le

42、nth, int_time, ret_val()End IfEnd FunctionPublic Function readsgls1(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByVal int_time As Integer, ByRef ret_val() As Single) As IntegerOn Error GoTo wrongDim i As IntegerDim lngStartTimer As LongDim byt_data(0) As ByteDim ret_byte() As Byte

43、Dim r_input() As ByteDim CRC() As ByteDim intCount As Integer byt_data(0) = lenth * 2 Do Until bln_busy = False Or (Abs(timeGetTime - lng_time 200) DoEvents DoEvents DoEvents DoEvents DoEventsLoopbln_busy = True frm_modbus.InBufferCount = 0 tran_modbus_order slv_id, 3, addr, byt_data lngStartTimer =

44、 timeGetTime bln_success = FalseDo Until Abs(timeGetTime - lngStartTimer) int_time Or bln_successDoEventsDoEventsDoEventsDoEventsDoEventsintCount = frm_modbus.InBufferCount If intCount = CInt(byt_data(0) * 2 + 5) Then bln_success = True frm_modbus.InputLen = 0 r_input = frm_modbus.Input frm_modbus.I

45、nBufferCount = 0End If Loop frm_main.Label2.Caption = timeGetTime - lngStartTimer + CLng(frm_main.Label2.Caption) If bln_success And intCount = CInt(byt_data(0) * 2 + 5) ThenCRC = CRC16(r_input)If CRC(0) = r_input(UBound(r_input) - 1) And CRC(1) = r_input(UBound(r_input) Then ret_byte = r_inputReDim

46、 ret_val(lenth - 1) As SingleDim byt(3) As ByteFor i = 0 To lenth - 1 byt(0) = ret_byte(i * 4 + 4) byt(1) = ret_byte(i * 4 + 3) byt(2) = ret_byte(i * 4 + 6) byt(3) = ret_byte(i * 4 + 5) ret_val(i) = bytTosgl(byt)Next i readsgls1 = 0Elsereadsgls1 = 2 End IfElseIf intCount 0 Thenreadsgls1 = 2Elsereads

47、gls1 = 1End Ifbln_busy = FalseDim ts_i As IntegerDim ts_str As StringIf (intCount 0) Thents_str = receive:For ts_i = 0 To UBound(r_input)ts_str = ts_str + CStr(Hex(r_input(ts_i) + Next ts_ifrm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.TextElsets_str = no receive:frm_main.Txt_

48、msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.TextEnd IfEnd Function写浮点数Public Function writesgls(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByRef sgl_data() As Single, ByVal int_time As Integer) As IntegerDim addr1 As IntegerDim addr2 As IntegerDim lenth1 As IntegerDi

49、m lenth2 As IntegerDim sgl_data1() As SingleDim sgl_data2() As SingleDim i As IntegerDim ret As IntegerIf lenth 50 ThenReDim sgl_data1(49) As SingleReDim sgl_data2(lenth - 51)lenth1 = 50lenth2 = lenth - lenth1addr1 = addraddr2 = addr + 100For i = 0 To 49sgl_data1(i) = sgl_data(i)Next iFor i = 50 To

50、lenth - 1sgl_data2(i - 50) = sgl_data(i)Next iret = writesgls1(slv_id, addr1, lenth1, sgl_data1, int_time)If (ret 0) Then writesgls = ret Exit FunctionEnd Ifret = writesgls1(slv_id, addr2, lenth2, sgl_data2, int_time)If (ret 0) Then writesgls = ret Exit FunctionEnd IfElsewritesgls = writesgls1(slv_i

51、d, addr, lenth, sgl_data(), int_time)End IfEnd FunctionPublic Function writesgls1(ByVal slv_id As Byte, ByVal addr As Long, ByVal lenth As Byte, ByRef sgl_data() As Single, ByVal int_time As Integer) As IntegerDim lngStartTimer As LongDim CRC() As ByteDim byt_data() As ByteDim r_input() As ByteDim i

52、 As IntegerDim byt(3) As ByteReDim byt_data(lenth * 4 - 1) As ByteFor i = 0 To lenth - 1 sglTobyt sgl_data(i), byt byt_data(4 * i) = byt(1) byt_data(4 * i + 1) = byt(0) byt_data(4 * i + 2) = byt(3) byt_data(4 * i + 3) = byt(2)Next iDo Until bln_busy = False Or (Abs(timeGetTime - lng_time 200) DoEven

53、tsLoopbln_busy = True frm_modbus.InBufferCount = 0 tran_modbus_order slv_id, 16, addr, byt_data lngStartTimer = timeGetTime bln_success = FalseStatic intCount As IntegerDo Until Abs(timeGetTime - lngStartTimer) int_time Or bln_successDoEvents intCount = frm_modbus.InBufferCountIf intCount = 8 Then b

54、ln_success = True frm_modbus.InputLen = 0 r_input = frm_modbus.Input frm_modbus.InBufferCount = 0End IfLoopIf bln_success And intCount = 8 ThenCRC = CRC16(r_input)If CRC(0) = r_input(UBound(r_input) - 1) And CRC(1) = r_input(UBound(r_input) Then writesgls1 = 0Else writesgls1 = 2End IfElseIf intCount

55、 0 Thenwritesgls1 = 2Elsewritesgls1 = 1End IfDim ts_i As IntegerDim ts_str As StringIf (intCount 0) Thents_str = receive:For ts_i = 0 To UBound(r_input) ts_str = ts_str + CStr(Hex(r_input(ts_i) + Next ts_ifrm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.Text Elsets_str = no receive: frm_main.Txt_msg.Text = ts_str + Chr(13) + Chr(10) + frm_main.Txt_msg.TextEnd Ifbln_busy = FalseEnd Function