Modbus_RTU_VB源碼
參數值：
進程說明：
/******20061026
實現故障監控，errorflag=1_故障
/******20061026
/******20061102
完成提示，優化界面
/******20061102
/******20061111-12
優化串行發送接收
/******20061111-12
/******20061114
優化串行發送接收,字符間隔精確，T1.5=4ms
/******20061114
/******20061114
監視兩臺，監視地址固定。讀參數地址可變
/******20061114
/******20061114
監視兩臺，監視地址固定。讀參數地址可變
/******20061114
/******20061117
發現功能碼03、06返回參數處理出錯
例如：收回十六進制0708處理成十進制為120
十六進制0708 →→78→→十進制120
修正后：
十六進制0708 →→708→→十進制1800
/******200611117
vb源程序如下:
- 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
所有資料51hei提供下載:
Modbus_RTU_VB源碼 _Modbus_RTU_VB源碼.rar
(4.27 MB, 下載次數: 163)
2018-11-12 11:29 上傳
點擊文件名下載附件
|
