?? 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 = "參數(shù)設(shè)定"
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位][寄存器數(shù)量高8位][寄存器數(shù)量低8位][CRC低字節(jié)][CRC高字節(jié)]
'寫多個保持寄存器值 功能碼＝10H
'[地址][功能碼][寄存器起始地址高8位][寄存器起始地址低8位][寄存器數(shù)量高8位][寄存器數(shù)量低8位][字節(jié)計數(shù)][數(shù)據(jù)高字節(jié)][數(shù)據(jù)低字節(jié)]...[數(shù)據(jù)高字節(jié)][數(shù)據(jù)低字節(jié)][CRC低字節(jié)][CRC高字節(jié)]
'寫單個保持寄存器值 功能碼＝06H
'[地址][功能碼][寄存器起始地址高8位][寄存器起始地址低8位][數(shù)據(jù)高字節(jié)][數(shù)據(jù)低字節(jié)][CRC低字節(jié)][CRC高字節(jié)]
'
'編程 劉勝紅 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 '數(shù)據(jù)長度
Dim n As Byte '循環(huán)量
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
'--------------------------------------------------------
' 獲得數(shù)據(jù)串
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) '按命令長度重新定義數(shù)組
CRC = &HFFFF& 'CRC初值
For n = 0 To BL - 1
fx(n) = CLng("&H" & Mid(ComStr, 2 * n + 1, 2)) '分解命令為字節(jié)
CRC = CrcResult(fx(n), &HA001&, CRC) 'CRC校驗碼生成調(diào)用
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))
'檢查數(shù)據(jù)是否正確
hexchrlen = Len(ComStr)
For hexcyc = 1 To hexchrlen '檢查Text1文本框內(nèi)數(shù)值是否合適
Hexchr = Mid(ComStr, hexcyc, 1)
If InStr("0123456789ABCDEFabcdef", Hexchr) = 0 Then
MsgBox "無效的數(shù)值，請重新輸入", , "錯誤信息"
Exit Sub
End If
Next
'分解數(shù)據(jù) 為 二進制發(fā)送 模式
' ReDim hexchrgroup(1 To hexchrlen \ 2) As Byte
ReDim hexchrgroup(hexchrlen \ 2 - 1) ' As Byte
For hexcyc = 1 To hexchrlen Step 2 '將文本框內(nèi)數(shù)值分成兩個、兩個
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 '數(shù)據(jù)長度
Dim n As Byte '循環(huán)量
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
'--------------------------------------------------------
' 獲得數(shù)據(jù)串
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) '按命令長度重新定義數(shù)組
CRC = &HFFFF& 'CRC初值
For n = 0 To BL - 1
fx(n) = CLng("&H" & Mid(ComStr, 2 * n + 1, 2)) '分解命令為字節(jié)
CRC = CrcResult(fx(n), &HA001&, CRC) 'CRC校驗碼生成調(diào)用
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))
'檢查數(shù)據(jù)是否正確
hexchrlen = Len(ComStr)
For hexcyc = 1 To hexchrlen '檢查Text1文本框內(nèi)數(shù)值是否合適
Hexchr = Mid(ComStr, hexcyc, 1)
If InStr("0123456789ABCDEFabcdef", Hexchr) = 0 Then
MsgBox "無效的數(shù)值，請重新輸入", , "錯誤信息"
Exit Sub
End If
Next
'分解數(shù)據(jù) 為 二進制發(fā)送 模式
ReDim hexchrgroup(1 To hexchrlen \ 2) As Byte
ReDim hexchrgroup(hexchrlen \ 2) 'As Byte
For hexcyc = 1 To hexchrlen Step 2 '將文本框內(nèi)數(shù)值分成兩個、兩個
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -