VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码.doc

VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码本人用的是Modbus RTU通讯模式，通过计算机串口转RS485与外围设备通行通讯，读写外围设备指定地址里的数据，从而达到自动化控制远端设备。Dim HiByte As ByteDim LoByte As ByteDim CRC16Lo As ByteDim CRC16Hi As ByteDim ReturnData(1) As ByteDim K As IntegerDim CmdLenth As IntegerPrivate Sub Command1_Click()K = Text9.Text 写6 个字节Text13.Text = = 数组赋值输入代码 =Dim WriteStr() As ByteDim u As IntegerReDim WriteStr(K + 2)For u = 0 To KWriteStr(u) = Val(&H & Text1(u).Text)NextDim CRC_2() As ByteDim v As IntegerReDim CRC_2(K)For v = 0 To KCRC_2(v) = Val(&H & Text1(v).Text)Next=Call CRC161(CRC_2()Call CRC16(WriteStr(), K) MSComm1.InBufferCount = 0= 显示发送代码 =Dim m As IntegerFor m = 0 To 23If m = K ThenText8(m).Text = Hex(WriteStr(m)ElseText8(m).Text = End IfNext=WriteStr(K + 1) = LoByteWriteStr(K + 2) = HiByte 发送代码Text4.Text = Dim g As IntegerFor g = 0 To K + 2Text4.Text = Text4.Text + + Hex(WriteStr(g)Next写命令发送后,当接收到8 个字节时中断CmdLenth = 8MSComm1.RThreshold = CmdLenthMSComm1.Output = WriteStrEnd SubPrivate Sub Command2_Click()EndEnd SubPrivate Sub Command3_Click()Label34.Caption = =Text13.Text = K = Text9.Text 写6 个字节= 数组赋值输入代码 =Dim CRC_2() As ByteDim v As IntegerReDim CRC_2(K)For v = 0 To KCRC_2(v) = Val(&H & Text1(v).Text)Next=Call CRC161(CRC_2()Call CRC16(WriteStr(), K) MSComm1.InBufferCount = 0= 显示发送代码 =Dim m As IntegerFor m = 0 To 23If m = K ThenText8(m).Text = Hex(WriteStr(m)ElseText8(m).Text = End IfNext=WriteStr(K + 1) = LoByteWriteStr(K + 2) = HiByte 发送代码Text4.Text = Dim g As IntegerFor g = 0 To K + 2Text4.Text = Text4.Text + + Hex(WriteStr(g)Next读命令发送后,当接收 5 + SendStr(5) * 2 个字节时产生中断CmdLenth = 5 + WriteStr(5) * 2MSComm1.RThreshold = CmdLenthMSComm1.Output = WriteStr 发送命令* * Dim sAddr As String Dim CheckString As String Dim CheckCode As String Dim CmdCode As String Dim Sum As Integer Dim a As Integer Dim tmp As Stringa = 0tmp = 0 Do While Len(tmp) = 3000 Then MSComm1.PortOpen = False Exit Function Exit Do End If LoopLabel33.Caption = tmpText16.Text = Len(tmp)Dim ns As IntegerFor ns = 1 To Len(tmp)Label34.Caption = Label34.Caption + + + Str(Asc(Mid(tmp, ns, 1)NextLabel35.Caption = Str(Val(Asc(Mid(tmp, 6, 1) / 10) tmp = Mid$(tmp, 6, 4) Dim strHex As String Dim Hex2Dec As Long Dim strTmp As String Dim longTmp As Long Dim longDec As Long Dim intLen As Integer Dim n1 As Integer strHex = Right$(tmp, 2) + Left$(tmp, 2) intLen = Len(strHex) For n1 = 1 To intLen strTmp = Mid(strHex, n1, 1) Select Case Asc(strTmp) Case 48 To 57 longTmp = Val(strTmp) Case 65 To 70 longTmp = Asc(strTmp) - 55 Case Else Hex2Dec = 0 Exit Function End Select Text13.Text = Text13.Text + + + Str(Asc(strTmp) longDec = longDec + longTmp * 16 (intLen - n1) Next n1 Hex2Dec = longDec Text13.Text = Hex2Dec * *End SubPrivate Sub MSComm1_OnComm()Dim Ne As Integer Select Case MSComm1.CommEvent Case comEvReceive Dim Buffer As Variant MSComm1.InputMode = comInputModeBinary MSComm1.InputLen = 0 Buffer = MSComm1.Input For Ne = LBound(Buffer) To UBound(Buffer) Text13.Text = Text13.Text & + & Buffer(Ne) Label34.Caption = Buffer(3) & & Buffer(4) Next Ne Case ElseEnd SelectBeepEnd SubPrivate Sub Command4_Click()End SubPrivate Sub Command5_Click()Label34.Caption = =End SubPrivate Sub Form_Load()MSComm1.Settings = 9600,N,8,1MSComm1.CommPort = 1MSComm1.SThreshold = 0If Not MSComm1.PortOpen Then MSComm1.PortOpen = TrueEnd SubPrivate Sub Timer1_Timer() 显示 结果Text2.Text = Hex(HiByte)Text3.Text = Hex(LoByte) 显示 结果Text6.Text = Hex(CRC16Hi)Text7.Text = Hex(CRC16Lo)If Text5.Text Then 十进制转十六进制Text10.Text = Hex(Text5.Text)End IfIf Text11.Text Then 十六进制转十进制Text12.Text = Val(&H & Text11.Text)End IfText14.Text = MSComm1.OutBufferCountEnd Sub= CRC校验 =Function CRC161(data() As Byte) As String CRC计算函数 Dim CRC16Lo As Byte, CRC16Hi 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 CRC16Lo = &HFF CRC16Hi = &HFF CL = &H1 CH = &HA0 For I = 0 To UBound(data) CRC16Lo = CRC16Lo Xor data(I) 每一个数据与CRC寄存器进行异或 For Flag = 0 To 7 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 CL