📄 frmvfd_rtu.frm
字号:
Top = 555
Width = 975
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
BorderStyle = 0 'None
Height = 285
Left = 1080
TabIndex = 11
Text = "VW"
Top = 600
Width = 495
End
Begin VB.Label Label3
Caption = "返回值："
Height = 375
Left = 240
TabIndex = 7
Top = 1800
Width = 975
End
Begin VB.Label Label2
Caption = "长度："
Height = 375
Left = 240
TabIndex = 6
Top = 1200
Width = 975
End
Begin VB.Label Label1
Caption = "起始地址："
Height = 375
Left = 240
TabIndex = 5
Top = 600
Width = 975
End
End
Begin VB.Frame Frame5
Caption = "参数设定"
Height = 735
Left = 120
TabIndex = 0
Top = 600
Width = 8895
Begin VB.ComboBox CombAddPLC
Height = 315
Left = 6000
TabIndex = 23
Text = "Combo6"
Top = 240
Width = 975
End
Begin VB.CommandButton CmdPort
Caption = "打开端口"
Height = 375
Left = 7320
TabIndex = 2
Top = 240
Width = 1215
End
Begin VB.ComboBox ComboPort
Height = 315
Left = 1440
TabIndex = 1
Top = 270
Width = 975
End
Begin VB.Label Label7
Caption = "从站地址："
Height = 255
Left = 4680
TabIndex = 22
Top = 240
Width = 975
End
Begin VB.Label Label8
Caption = "端口选择："
Height = 375
Left = 240
TabIndex = 21
Top = 240
Width = 975
End
End
Begin MSCommLib.MSComm MSComm1
Left = 0
Top = 0
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
ParityReplace = 64
RTSEnable = -1 'True
ParitySetting = 2
InputMode = 1
End
End
Attribute VB_Name = "FrmMain1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************************************************************
'读多个保持寄存器值 功能码＝03H
'[地址][功能码][寄存器起始地址高8位][寄存器起始地址低8位][寄存器数量高8位][寄存器数量低8位][CRC低字节][CRC高字节]
'写多个保持寄存器值 功能码＝10H
'[地址][功能码][寄存器起始地址高8位][寄存器起始地址低8位][寄存器数量高8位][寄存器数量低8位][字节计数][数据高字节][数据低字节]...[数据高字节][数据低字节][CRC低字节][CRC高字节]
'写单个保持寄存器值 功能码＝06H
'[地址][功能码][寄存器起始地址高8位][寄存器起始地址低8位][数据高字节][数据低字节][CRC低字节][CRC高字节]
'
'编程 刘胜红 2007-07-13
'************************************************************************************************
Option Explicit
Public AddPLC As String
Public FlagVW As Boolean
Public FlagVD As Boolean
Public RecVW As String
Public RecVD As String
Public FLAG As Boolean
'
Private Sub CmdPort_Click()
If MSComm1.PortOpen = False Then
MSComm1.CommPort = Me.ComboPort.ListIndex + 1
MSComm1.Settings = "19200,e,8,1"
MSComm1.InputMode = comInputModeBinary
MSComm1.PortOpen = True
' Timer1.Enabled = True
End If
If Err Then '打开串口失败，则显示出错信息
MsgBox Error$, 48, "错误信息"
Exit Sub
End If
End Sub
Private Sub CmdReadVD_Click()
Dim AddRead As String
' Dim NumRead As Integer
' Dim A As Single
AddPLC = CStr(Me.CombAddPLC.Text)
' NumRead = Val(Me.CobNumRead.Text)
AddRead = CStr(TextAddR.Text)
' A = HextoSng("41CC0000")
FrameFun AddPLC, 3, AddRead, 2
MSComm1.RThreshold = 9
FlagVD = True
End Sub
Private Sub CmdReadVW_Click()
Dim AddRead As String
' Dim NumRead As Integer
AddPLC = CStr(Me.CombAddPLC.Text)
' NumRead = Val(Me.CobNumRead.Text)
AddRead = CStr(TextAddR.Text)
FrameFun AddPLC, 3, AddRead, 1
MSComm1.RThreshold = 7
FlagVW = True
End Sub
Private Sub CmdWriteVD_Click()
Dim AddWrite As String
'Dim NumWrite As Integer
Dim DataWrite As Single
AddPLC = CStr(Me.CombAddPLC.Text)
' NumWrite = Val(Me.CobNumWrite.Text)
AddWrite = CStr(TextAddD.Text)
DataWrite = Val(Me.TextDataD.Text)
FrameFunTwo AddPLC, 10, AddWrite, 2, 4, DataWrite
MSComm1.RThreshold = 8
End Sub
Private Sub CmdWriteVW_Click()
Dim AddWrite As String
'Dim NumWrite As Integer
Dim DataWrite As Integer
AddPLC = CStr(Me.CombAddPLC.Text)
' NumWrite = Val(Me.CobNumWrite.Text)
AddWrite = CStr(TextAddW.Text)
DataWrite = Val(Me.TextDataW.Text)
FrameFun AddPLC, 6, AddWrite, DataWrite
MSComm1.RThreshold = 7
End Sub
Private Sub CombAddPLC_Change()
AddPLC = Me.CombAddPLC.ListIndex
End Sub
Private Sub Form_Load()
Dim i As Integer
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
ComboPort.AddItem "1"
ComboPort.AddItem "2"
ComboPort.AddItem "3"
ComboPort.ListIndex = 0
For i = 0 To 254
CobNumRead.AddItem i
CobNumWrite.AddItem i
Me.CombAddPLC.AddItem i
Next
Me.CombAddPLC.ListIndex = 2
CobNumRead.ListIndex = 1
CobNumWrite.ListIndex = 1
FlagVW = False
FlagVD = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End Sub
Sub FrameFun(Addr As String, Cmd As String, Register As String, Data As Integer)
Dim ComStr As String
Dim Temp(6) As String
Dim BL As Byte '数据长度
Dim n As Byte '循环量
Dim CRC As Long 'CRC寄存器
Dim fx() As Byte
Dim hexchrlen%
Dim Hexchr As String
Dim hexcyc%
Dim hexmid As Byte
Dim hexmiddle As String
Dim hexchrgroup() As Byte
Dim i As Integer
'--------------------------------------------------------
' 获得数据串
MSComm1.OutBufferCount = 0
Temp(0) = Chr_2(Addr)
Temp(1) = Chr_2(Cmd)
Temp(2) = Chr_4(Hex(Register))
Temp(3) = Chr_4(Hex(Data))
ComStr = Temp(0) + Temp(1) + Temp(2) + Temp(3)
'---CRC -----------------------------------------------------
BL = Len(ComStr) / 2
ReDim fx(BL + 1) '按命令长度重新定义数组
CRC = &HFFFF& 'CRC初值
For n = 0 To BL - 1
fx(n) = CLng("&H" & Mid(ComStr, 2 * n + 1, 2)) '分解命令为字节
CRC = CrcResult(fx(n), &HA001&, CRC) 'CRC校验码生成调用
Next
fx(BL) = CByte(CRC And &HFF&) '得到的校验低位
fx(BL + 1) = CByte(Fix(CRC / 256) And &HFF&) '得到的校验高位
Temp(4) = Chr_2(Hex(fx(BL)))
Temp(5) = Chr_2(Hex(fx(BL + 1)))
ComStr = Trim(ComStr + Temp(4) + Temp(5))
'检查数据是否正确
hexchrlen = Len(ComStr)
For hexcyc = 1 To hexchrlen '检查Text1文本框内数值是否合适
Hexchr = Mid(ComStr, hexcyc, 1)
If InStr("0123456789ABCDEFabcdef", Hexchr) = 0 Then
MsgBox "无效的数值，请重新输入", , "错误信息"
Exit Sub
End If
Next
'分解数据 为 二进制发送 模式
' ReDim hexchrgroup(1 To hexchrlen \ 2) As Byte
ReDim hexchrgroup(hexchrlen \ 2 - 1) ' As Byte
For hexcyc = 1 To hexchrlen Step 2 '将文本框内数值分成两个、两个
Hexchr = Mid(ComStr, hexcyc, 2)
' Hexchr = "FF"
hexmid = Val("&H" & CStr(Hexchr))
hexchrgroup(i) = hexmid
i = i + 1
Next
MSComm1.Output = hexchrgroup ''''ComStr '
Sleep 100
End Sub
Sub FrameFunTwo(Addr As String, Cmd As String, Register As String, Number As String, ByteNum As String, Data As Single)
Dim ComStr As String
Dim Temp(7) As String
Dim BL As Byte '数据长度
Dim n As Byte '循环量
Dim CRC As Long 'CRC寄存器
Dim fx() As Byte
Dim hexchrlen%
Dim Hexchr As String
Dim hexcyc%
Dim hexmid As Byte
Dim hexmiddle As String
Dim hexchrgroup() As Byte
Dim i As Integer
'--------------------------------------------------------
' 获得数据串
MSComm1.OutBufferCount = 0
Temp(0) = Chr_2(Addr)
Temp(1) = Chr_2(Cmd)
Temp(2) = Chr_4(Hex(Register))
Temp(3) = Chr_4(Hex(Number))
Temp(4) = Chr_2(Hex(ByteNum))
Temp(5) = SngtoHex(Data)
ComStr = Temp(0) + Temp(1) + Temp(2) + Temp(3) + Temp(4) + Temp(5)
'---CRC -----------------------------------------------------
BL = Len(ComStr) / 2
ReDim fx(BL + 1) '按命令长度重新定义数组
CRC = &HFFFF& 'CRC初值
For n = 0 To BL - 1
fx(n) = CLng("&H" & Mid(ComStr, 2 * n + 1, 2)) '分解命令为字节
CRC = CrcResult(fx(n), &HA001&, CRC) 'CRC校验码生成调用
Next
fx(BL) = CByte(CRC And &HFF&) '得到的校验低位
fx(BL + 1) = CByte(Fix(CRC / 256) And &HFF&) '得到的校验高位
Temp(6) = Chr_2(Hex(fx(BL)))
Temp(7) = Chr_2(Hex(fx(BL + 1)))
ComStr = Trim(ComStr + Temp(6) + Temp(7))
'检查数据是否正确
hexchrlen = Len(ComStr)
For hexcyc = 1 To hexchrlen '检查Text1文本框内数值是否合适
Hexchr = Mid(ComStr, hexcyc, 1)
If InStr("0123456789ABCDEFabcdef", Hexchr) = 0 Then
MsgBox "无效的数值，请重新输入", , "错误信息"
Exit Sub
End If
Next
'分解数据 为 二进制发送 模式
ReDim hexchrgroup(1 To hexchrlen \ 2) As Byte
ReDim hexchrgroup(hexchrlen \ 2) 'As Byte
For hexcyc = 1 To hexchrlen Step 2 '将文本框内数值分成两个、两个
i = i + 1
Hexchr = Mid(ComStr, hexcyc, 2)
' Hexchr = "FF"
hexmid = Val("&H" & CStr(Hexchr))
hexchrgroup(i) = hexmid
Next
MSComm1.Output = hexchrgroup ''''ComStr '
Sleep 100
End Sub
Private Sub MSComm1_OnComm()
Dim Inbyte() As Byte
Dim InHEx As String
Dim i, j As Integer
' TextDataR.Text = ""
ReDim inSafeArray(MSComm1.RThreshold)
If MSComm1.CommEvent = comEvReceive Then '收到 RThreshold # of chars.
Inbyte = MSComm1.Input
For i = 0 To MSComm1.RThreshold - 1
InHEx = Hex(Val(Inbyte(i)))
inSafeArray(i) = IIf(Len(InHEx) < 2, "0" + InHEx, InHEx)
Me.Text6.Text = Me.Text6.Text & inSafeArray(i)
Next i
RecVW = Text6.Text
FLAG = 1
If FlagVW = True Then
RecVW = Text6.Text
Call ProcessRecVW
For j = 3 To MSComm1.RThreshold - 3 Step 2
Me.TextDataRW.Text = Me.TextDataRW.Text + " " & DataVW((j - 3) / 2)
Next j
ElseIf FlagVD = True Then
RecVD = Text6.Text
Call ProcessRecVD
For j = 3 To MSComm1.RThreshold - 3 Step 4
Me.TextDataRD.Text = Me.TextDataRD.Text + " " & DataVD((j - 3) / 4)
Next j
End If
End If
End Sub
Private Sub ComboPort_Click() '串口选择
MSComm1.CommPort = ComboPort.ListIndex + 1
End Sub
Private Sub Timer1_Timer()
Dim AddRead As String
' Dim NumRead As Integer
' Dim A As Single
AddPLC = CStr(Me.CombAddPLC.Text)
' NumRead = Val(Me.CobNumRead.Text)
AddRead = CStr(TextAddR.Text)
' A = HextoSng("41CC0000")
FrameFun AddPLC, 3, AddRead, 2
MSComm1.RThreshold = 9
FlagVD = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -