手机版

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

发布时间:2024-11-21   来源:未知    
字号:

VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码本人用的是Modbus RTU通讯模式,通过计算机串口转RS485与外围设备通行通讯,读写外围设备指定地址里的数据,从而达到自动化控制远端设备。

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

本人用的是Modbus RTU通讯模式,通过计算机串口转RS485与外围设备通行通讯,读写外围设备指定地址里的数据,从而达到自动化控制远端设备。

Dim HiByte As Byte

Dim LoByte As Byte

Dim CRC16Lo As Byte

Dim CRC16Hi As Byte

Dim ReturnData(1) As Byte

Dim K As Integer

Dim CmdLenth As Integer

Private Sub Command1_Click()

K = Text9.Text '写6 个字节

Text13.Text = ""

'=========== 数组赋值输入代码 =======================================================================================

'<< 算法一 >>

Dim WriteStr() As Byte

Dim u As Integer

ReDim WriteStr(K + 2)

For u = 0 To K

WriteStr(u) = Val("&H" & Text1(u).Text)

Next

'<< 算法二 >>

Dim CRC_2() As Byte

Dim v As Integer

ReDim CRC_2(K)

For v = 0 To K

CRC_2(v) = Val("&H" & Text1(v).Text)

Next

'==================================================================================================

Call CRC161(CRC_2())

VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码本人用的是Modbus RTU通讯模式,通过计算机串口转RS485与外围设备通行通讯,读写外围设备指定地址里的数据,从而达到自动化控制远端设备。

Call CRC16(WriteStr(), K)

MSComm1.InBufferCount = 0

'========== 显示发送代码 ========================================================================================

Dim m As Integer

For m = 0 To 23

If m <= K Then

Text8(m).Text = Hex(WriteStr(m))

Else

Text8(m).Text = ""

End If

Next

'==================================================================================================

WriteStr(K + 1) = LoByte

WriteStr(K + 2) = HiByte

' 发送代码

Text4.Text = ""

Dim g As Integer

For g = 0 To K + 2

Text4.Text = Text4.Text + " " + Hex(WriteStr(g))

Next

'写命令发送后,当接收到8 个字节时中断

CmdLenth = 8

MSComm1.RThreshold = CmdLenth

MSComm1.Output = WriteStr

End Sub

Private Sub Command2_Click()

End

End Sub

Private Sub Command3_Click()

VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码本人用的是Modbus RTU通讯模式,通过计算机串口转RS485与外围设备通行通讯,读写外围设备指定地址里的数据,从而达到自动化控制远端设备。

Label34.Caption = "="

Text13.Text = ""

K = Text9.Text '写6 个字节

'===========

========

'<< 算法 >>

Dim CRC_2() As Byte

Dim v As Integer

ReDim CRC_2(K)

For v = 0 To K

CRC_2(v) = Val("&H" & Text1(v).Text)

Next

'==================================================================================================

Call CRC161(CRC_2())

Call CRC16(WriteStr(), K)

MSComm1.InBufferCount = 0

'========== 显示发送代码 ========================================================================================

Dim m As Integer

For m = 0 To 23

If m <= K Then

Text8(m).Text = Hex(WriteStr(m))

Else

Text8(m).Text = ""

End If

Next

'==================================================================================================

WriteStr(K + 1) = LoByte 数组赋值输入代码 ===============================================================================

VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码本人用的是Modbus RTU通讯模式,通过计算机串口转RS485与外围设备通行通讯,读写外围设备指定地址里的数据,从而达到自动化控制远端设备。

WriteStr(K + 2) = HiByte

' 发送代码

Text4.Text = ""

Dim g As Integer

For g = 0 To K + 2

Text4.Text = Text4.Text + " " + Hex(WriteStr(g))

Next

'读命令发送后,当接收 5 + SendStr(5) * 2 个字节时产生中断

CmdLenth = 5 + WriteStr(5) * 2

MSComm1.RThreshold = CmdLenth

MSComm1.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 String

'a = 0

'tmp = 0

'

'

'

' Do While Len(tmp) < 8

'

' tmp = tmp + MSComm1.Input

' testNO.Caption = testNO.Caption + " " + Str(Hex(Asc(tmp)))

' a = a + 1

' If a >= 3000 Then

' MSComm1.PortOpen = False

VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码本人用的是Modbus RTU通讯模式,通过计算机串口转RS485与外围设备通行通讯,读写外围设备指定地址里的数据,从而达到自动化控制远端设备。

'Exit Function

' Exit Do

' End If

' Loop

'Label33.Caption = tmp

'Text16.Text = Len(tmp)

'Dim ns As Integer

'For ns = 1 To Len(tmp)

'Label34.Caption = Label34.Caption + "+" + Str(Asc(Mid(tmp, ns, 1)))

'

'Next

'Label35.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

VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码本人用的是Modbus RTU通讯模式,通过计算机串口转RS485与外围设备通行通讯,读写外围设备指定地址里的数据,从而达到自动化控制远端设备。

' Text13.Text = Hex2Dec

'****************************************************************************************************************************************

'********************************************************** *********************************************************

'****************************************************************************************************************************************

End Sub

Private Sub MSComm1_OnComm()

Dim Ne As Integer

Select Case http://mEvent

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 Else

End Select

Beep

End Sub

Private Sub Command4_Click()

End Sub

Private Sub Command5_Click()

Label34.Caption = "="

VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码本人用的是Modbus RTU通讯模式,通过计算机串口转RS485与外围设备通行通讯,读写外围设备指定地址里的数据,从而达到自动化控制远端设备。

Private Sub Form_Load()

MSComm1.Settings = "9600,N,8,1"

http://mPort = 1

MSComm1.SThreshold = 0

If Not MSComm1.PortOpen Then MSComm1.PortOpen = True

End Sub

Private 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 If

If Text11.Text <> "" Then '十六进制转十进制

Text12.Text = Val("&H" & Text11.Text)

End If

Text14.Text = MSComm1.OutBufferCount

End 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

VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码本人用的是Modbus RTU通讯模式,通过计算机串口转RS485与外围设备通行通讯,读写外围设备指定地址里的数据,从而达到自动化控制远端设备。

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

End If

Next Flag

Next I

Dim ReturnData(1) As Byte

ReturnData(0) = CRC16Hi 'CRC高位

VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码本人用的是Modbus RTU通讯模式,通过计算机串口转RS485与外围设备通行通讯,读写外围设备指定地址里的数据,从而达到自动化控制远端设备。

ReturnData(1) = CRC16Lo 'CRC低位

asd = Right("00" + Hex(CRC16Lo), 2) + Right("00" + Hex(CRC16Hi), 2)

End Function

Private Sub mscomm_OnComm()

End Sub

VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码.doc 将本文的Word文档下载到电脑,方便复制、编辑、收藏和打印
    ×
    二维码
    × 游客快捷下载通道(下载后可以自由复制和排版)
    VIP包月下载
    特价:29 元/月 原价:99元
    低至 0.3 元/份 每月下载150
    全站内容免费自由复制
    VIP包月下载
    特价:29 元/月 原价:99元
    低至 0.3 元/份 每月下载150
    全站内容免费自由复制
    注:下载文档有可能出现无法下载或内容有问题,请联系客服协助您处理。
    × 常见问题(客服时间:周一到周五 9:30-18:00)