一 工具
vb 6.0 编程
xframe 配置RS485
access2003 存储数据库
二 代码
Option Explicit
Dim strData As String
Dim zhanHao As String
Dim i As Integer
Dim j As Integer
Dim x As Integer '7代表温度
Dim wd As String 'wd代表温度的解析值
Dim sd As String 'wd代表湿度的解析值
Dim strData1 As String
Dim strData2 As String
Dim sckConnection1 As Boolean
'提取温湿度的数值
Private Function response(sz As String)
Dim b As Integer
Dim n As Integer
Dim a As Double
Dim hex As String
Dim i As Long
Dim y As Integer
hex = Mid(sz, 7, 4)
b = 0
a = 0
For i = 1 To 4
Select Case Mid(hex, 4 - i + 1, 1)
Case "0": b = b + 16 ^ (i - 1) * 0
Case "1": b = b + 16 ^ (i - 1) * 1
Case "2": b = b + 16 ^ (i - 1) * 2
Case "3": b = b + 16 ^ (i - 1) * 3
Case "4": b = b + 16 ^ (i - 1) * 4
Case "5": b = b + 16 ^ (i - 1) * 5
Case "6": b = b + 16 ^ (i - 1) * 6
Case "7": b = b + 16 ^ (i - 1) * 7
Case "8": b = b + 16 ^ (i - 1) * 8
Case "9": b = b + 16 ^ (i - 1) * 9
Case "A": b = b + 16 ^ (i - 1) * 10
Case "B": b = b + 16 ^ (i - 1) * 11
Case "C": b = b + 16 ^ (i - 1) * 12
Case "D": b = b + 16 ^ (i - 1) * 13
Case "E": b = b + 16 ^ (i - 1) * 14
Case "F": b = b + 16 ^ (i - 1) * 15
End Select
Next i
a = b / 10
y = Int(b / 100)
If y = 0 Then
response = "湿度是" & b & "H"
Else
response = "温度是" & a & "C"
End If
End Function
Private Sub insert_num(b As Integer, c, d, e, f As String)
Adodc1.RecordSource = "select * from test"
Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields("date") = Now()
Adodc1.Recordset.Fields("tell") = "地址为" & b & "号"
Adodc1.Recordset.Fields("tnum") = c
Adodc1.Recordset.Fields("hnum") = d
Adodc1.Recordset.Fields("humi") = e
Adodc1.Recordset.Fields("temp") = f
End Sub
Private Sub Form_Load()
Dim s As Integer
Winsock3.LocalPort = 6031
Winsock3.Listen
Timer5.Enabled = True
Timer5.Interval = 3000
End Sub
Private Sub Timer5_Timer()
'获取温度测试串
strData2 = ""
Dim bisend(7) As Byte
Dim crc
Dim btLoCRC As Byte, btHiCRC As Byte
Dim Data As Integer
j = j + 1
If j = 50 Or j = 51 Then
bisend(0) =j
bisend(1) =3
bisend(2) = 0
bisend(3) = 7
x = 7
bisend(4) =0
bisend(5) = 1
crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
bisend(6) =btLoCRC
bisend(7) = btHiCRC
End If
If j = 52 Then j = 0
Winsock3.SendData bisend
Timer6.Enabled = True
Timer6.Interval = 2000
End Sub
Private Sub Winsock3_ConnectionRequest(ByVal RequestID As Long)
Dim myStr As String
If Winsock3.State <> sckClosed Then
Winsock3.Close
Winsock3.Accept RequestID
MsgBox "建立连接1"
End If
End Sub
Private Sub Winsock3_DataArrival(ByVal bytesTotal As Long)
Dim a As String
Dim b As String
Dim myStr() As Byte
myStr = ""
strData = ""
Winsock3.GetData myStr
Dim i As Integer
Dim crc
Dim btLoCRC As Byte, btHiCRC As Byte
If myStr(1) = 3 Then '读寄存器
'CRC校验
crc = CRC16(myStr, UBound(myStr) - LBound(myStr) - 1, btLoCRC, btHiCRC)
If myStr(UBound(myStr) - 1) = btLoCRC And myStr(UBound(myStr)) = btHiCRC Then
'校验正确
For i = 0 To UBound(myStr)
If Len(hex(myStr(i))) = 1 Then
strData = strData & "0" & hex(myStr(i))
Else
strData = strData & hex(myStr(i))
End If
Next
End If
End If
If x = 8 Then '湿度
Text2.Text = strData
strData1 = strData
Print "湿度:" & strData
Print "湿度:" & Text2.Text
sd = response(strData1)
Print "xxxxxxx:" & sd
ElseIf x = 7 Then
Text1.Text = strData
strData2 = strData
wd = response(Text1.Text)
End If
If strData1 <> "" And strData2 <> "" And wd <> "" And sd <> "" Then
Call insert_num(j, strData2, strData1, sd, wd)
End If
End Sub
Function CRC16(Data() As Byte, no As Integer, CRC16Lo As Byte, CRC16Hi As Byte) As String
Dim CL As Byte, CH As Byte '多项式码&HA001
Dim SaveHi As Byte, SaveLo As Byte
Dim i As Integer
Dim Flag As Integer
CRC16Lo = &HFF '255
CRC16Hi = &HFF '255
CL = &H1 '1
CH = &HA0 '160
For i = 0 To no - 1
CRC16Lo = CRC16Lo Xor Data(i) '每一个数据与CRC寄存器进行异或
For Flag = 0 To 7
SaveHi = CRC16Hi
SaveLo = CRC16Lo
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高位
ReturnData(1) = CRC16Lo 'CRC低位
CRC16 = ReturnData
End Function
这个代码实现的是
modbus通讯
