Modbus_RTU_VB源码 - - Powered by Discuz!

Private Function Hexsent(ByVal smf_code As String, ByVal sdata_saddr As String, ByVal sdata_num As String, ByVal intGetDataLen As Integer, ByVal intdisnum As Integer, ByVal Hexsent_String As String) As Integer
Dim hexchrlen%, Hexchr As String, hexcyc%, hexmid As Byte
Dim hexchrgroup() As Byte, hexchrgrouprgt() As Byte
Dim j%
Dim dfMinus, dfFreq, dfTim As Double
Dim msn1, msn2 As String
'接收的数据
Dim bytReceiveArray() As Byte
'接收的变体数据
Dim VarReceiveData As String
Dim b As Variant
Dim i As Long, ii As Long, num_flag0&, num_flag1&, m As Long
On Error Resume Next
hexchrlen = Len(Hexsent_String)
'检查参数值是否合适
For hexcyc = 1 To hexchrlen
Hexchr = Mid(Hexsent_String, hexcyc, 1)
If InStr("0123456789ABCDEFabcdef", Hexchr) = 0 Then
MsgBox "无效的数值，请重新输入", , "错误信息"
Exit Function
End If
Next
'将参数值分成两个、两个
ReDim hexchrgroup(1 To hexchrlen \ 2) As Byte
For hexcyc = 1 To hexchrlen Step 2
i = i + 1
Hexchr = Mid(Hexsent_String, hexcyc, 2)
hexmid = Val("&H" & CStr(Hexchr))
hexchrgroup(i) = hexmid
Next
''主站开始的空闲时间T3.5''主站开始的空闲时间T3.5''主站开始的空闲时间T3.5'主站开始的空闲时间T3.5
If FstHexSent = 1 Then
FstHexSent = 0
Call timedelays(T3_5)
idle = 1
ElseIf idle = 0 Then
Do
If GetQueueStatus(QS_ALLINPUT) Then DoEvents '如果正在发送或接收数据则等待到发送或接收完成
Loop Until idle = 1
End If
'查询一个从机
If Mid(Hexsent_String, 1, 2) > 0 And idle = 1 Then
idle = 0
retry_num = 3
replytimeoutflag = 0
MSComm1.InBufferCount = 0
hexchrgrouprgt = hexchrgroup
MSComm1.Output = hexchrgrouprgt
'是否发送完毕
Do Until MSComm1.OutBufferCount = 0
If GetQueueStatus(QS_ALLINPUT) Then DoEvents
Loop
Call timedelays(T3_5)
QueryPerformanceCounter overreptim
idle = 1
Wait_reply:
Do
If MSComm1.InBufferCount And idle = 1 Then
idle = 0
VarReceiveData = MSComm1.Input
bytReceiveArray = VarReceiveData
If Mid(Hexsent_String, 1, 2) = Tran(Hex(Val(bytReceiveArray(0))), 16) Then '地址校验
Unexpection_sl = 0
GoTo Datareceive
Else
idle = 1
Unexpection_sl = 1
GoTo Wait_reply
End If
Else
QueryPerformanceFrequency f
QueryPerformanceCounter l
dfTim = (l.lowpart - overreptim.lowpart) / f.lowpart
End If
Loop Until dfTim > 2
replytimeoutflag = 1
GoTo processing_error
Datareceive:
VarReceiveData = VarReceiveData & MSComm1.Input
QueryPerformanceCounter k
Do
If MSComm1.InBufferCount Then
GoTo Datareceive
Else
QueryPerformanceCounter l
dfTim = (l.lowpart - k.lowpart) / f.lowpart
End If
Loop Until dfTim > 0.001 '判断T1.5超时
'帧控制(CRC校验)
bytReceiveArray = VarReceiveData
msn = bytReceiveArray
i = LenB(msn)
ii = i
msn = ""
Text6text = ""
For j = 0 To i - 1
m = Tran(Hex(Val(bytReceiveArray(j))), 16)
If m <= 16 Then
Text6text = Text6text & "0" & Hex(Val(bytReceiveArray(j))) & " "
msn = msn & "0" & Hex(Val(bytReceiveArray(j)))
Else
Text6text = Text6text & Hex(Val(bytReceiveArray(j))) & " "
msn = msn & Hex(Val(bytReceiveArray(j)))
End If
Next j
msn1 = Right$(msn, 4)
msn2 = Mid(msn, 1, (i - 2) * 2)
msn2 = RTUcheckString(msn2)
msn2 = Mid(msn2, (i - 1) * 2 - 1, 4)
i = StrComp(msn1, msn2, 1)
If i = 0 Then
Frameok_flag = 1
Else
Frameok_flag = 0
GoTo processing_error
End If
'T3.5超时判断
Do
QueryPerformanceCounter l
dfTim = (l.lowpart - k.lowpart) / f.lowpart
Loop Until dfTim > T3_5
If Frameok_flag = 0 Then
GoTo processing_error
Else
GoTo process_reply
End If
processing_error: ''''''''''''''''''''''''''''''''''处理到这里了|||||||||||||||||||||||||||||||||
If RESTART = 1 Then
'7'If replytimeoutflag = 1 Then
'7' Hexsent = 1
'7' replytimeoutflag = 0
'7' idle = 1
'7' ERR = ERR + 1
'7'Else
Hexsent = 0
RESTART = 0
'7'End If
ElseIf replytimeoutflag = 1 Then
Hexsent = 1
replytimeoutflag = 0
idle = 1
ERR = ERR + 1
ElseIf Frameok_flag = 0 Then
Hexsent = 2
idle = 1
ERR = ERR + 1
End If
Exit Function
''''''2''' retry_num = retry_num - 1
''''''2''' If retry_num >= 0 Then
''''''2''' GoTo retry
''''''2''' Else
''''''2''' idle = 1
''''''2''' Exit Function
''''''2''' End If

复制代码