vb 测传感器的温湿度、各种气体和风速（验收版本）

传感器（-130米主通风井）
192.168.16.128(6041)
设备名称	设备地址（modbus）	京金华服务器
风速传感器	6
H2S	42	地点	IP地址		端口号
S02	40	1#130米井马头门	192.168.16.114		6017
TH	45	-130米斜井	192.168.16.102		6019
O2	43	130水泵房	192.168.16.128	1	6071
CO	44	2#井-240米马头门	192.168.16.104		6014
NO2	41	-240水泵房	192.168.16.118		6011
传感器（2#井-290米马头门）		2#井-290米马头门	192.168.16.112	2	6021
		3#井-290马头门	192.168.16.130		6024
192.168.16.112(6044)		-290米避灾硐室	192.168.16.124		6022
设备名称	设备地址（modbus）	-290米配电房	192.168.16.126		6015
TH	23	3#井-340米马头门	192.168.16.116	3	6040
CO	24	-340米盲竖井马头门	192.168.16.136		6016
NO2	21	3#井-400米马头门	192.168.16.100	4	6088
H2S	22	-400米避灾硐室	192.168.16.140	5	6020
SO2	20	-400米盲竖井	192.168.16.132		6023
风速传感器	4	1#井口	192.168.16.122		6013
传感器（2#井-290米避灾硐室）		2#井口	192.168.16.110		6061
		3#井口	192.168.16.108		6010
192.168.16.116(6045)		硐口	192.168.16.106		6018
设备名称	设备地址（modbus）
TH	31
CO	30
CO2	32
O2	33
大气压检测	5
传感器（3#井-400米马头门）
192.168.16.100(6043)
设备名称	设备地址（modbus）
TH	50
CO	51
传感器（-400米避灾硐室）
192.168.16.130(6048)
设备名称	设备地址（modbus）
TH	11
CO	10
CO2	13
O2	12
大气压检测	3

这个是xfame京金华服务器配置情况；

一下是vb代码：

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim strData As String
Dim num As Integer
Dim i As Integer '代表各个地址
Dim x As Integer   '7代表温度 8代表湿度
Dim wd As String   'wd代表温度的解析值
Dim sd As String   'wd代表湿度的解析值
Dim strData1 As String
Dim strData2 As String
Public m As Integer 'm代表6040-6044
Dim sckConnection1 As Boolean
'提取温湿度的数值
Private Function response(sz As String)
Dim b As Long
Dim n As Integer
Dim a As Double
Dim hex As String
Dim i As Long
Dim y As Double
 b = 0
 a = 0
 Dim s As Integer
 If x = 0 Or x = 7 Or x = 8 Then
 s = 4
 ElseIf x = 5 Then
 s = 8
 End If
  hex = Mid(sz, 7, s)
        For i = 1 To s
            Select Case Mid(hex, s - 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
            If x = 0 Then
            If b < 100 Then y = b
            If b > 100 Then y = b / 100
            ElseIf x = 8 Then
            y = b
            ElseIf x = 7 Then
            y = b / 10
             ElseIf x = 5 Then '这个是大气压
            y = b / 1000
            End If
          response = y
End Function
Private Sub insert_num(b As Integer, c, d, e, f As String)
Adodc2.RecordSource = "select * from test"
Adodc2.Recordset.AddNew
Adodc2.Recordset.Fields("date") = Now()
Adodc2.Recordset.Fields("tell") = "地址为" & b & "号"
Adodc2.Recordset.Fields("tnum") = c
Adodc2.Recordset.Fields("hnum") = d
Adodc2.Recordset.Fields("humi") = e
Adodc2.Recordset.Fields("temp") = f
End Sub
Private Sub Form_Load()
Dim s As Integer
On Error Resume Next
m = 0
i = 1
Timer6.Enabled = True
Timer6.Interval = 10000
End Sub
Private Sub Timer6_Timer()
Dim j As Long
i = 1
Winsock1.Close
m = m + 1
On Error Resume Next
Select Case m
Case 1: Winsock1.LocalPort = 6044
        Winsock1.Listen
Case 2: Winsock1.LocalPort = 6041
        Winsock1.Listen
Case 3: Winsock1.LocalPort = 6045
        Winsock1.Listen
Case 4: Winsock1.LocalPort = 6043
        Winsock1.Listen
Case Else:
        Winsock1.LocalPort = 6048
        Winsock1.Listen
End Select
If m = 6 Then m = 1
Timer5.Enabled = True
Timer5.Interval = 5000
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal RequestID As Long)
Dim myStr As String
    If Winsock1.State <> sckClosed Then
            Winsock1.Close
            Winsock1.Accept RequestID
           ' MsgBox "建立连接"
    End If
End Sub
Private Sub Timer5_Timer()
 '获取温度测试串
    strData1 = ""
    Dim bisend(7) As Byte
    Dim crc
    Dim btLoCRC As Byte, btHiCRC As Byte
    Dim Data As Integer
    Dim j As Long
If m = 2 Then
Select Case i
Case 1:
        bisend(0) = 6 '风速
         bisend(3) = 0
           x = 0
Case 2:
        bisend(0) = 40 'S02
         bisend(3) = 0
           x = 0
Case 3:
        bisend(0) = 41 'N02
         bisend(3) = 0
Case 4:
        bisend(0) = 42 'H2S
         bisend(3) = 0
Case 5:
        bisend(0) = 43 'O2
         bisend(3) = 0
           x = 0
Case 6:
        bisend(0) = 44 'CO
         bisend(3) = 0
         x = 0
Case 7:
        bisend(0) = 45 'TH
         bisend(3) = 7
         x = 7
Case Else:
        bisend(0) = 45 'TH
         bisend(3) = 8
         x = 8
End Select
i = i + 1
If i = 9 Then i = 1
        bisend(1) = 3
        bisend(2) = 0
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
         '判断是否连接了，才发送数据
         j = 1
         On Error Resume Next
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
       Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then Winsock1.SendData bisend
     
        
        ElseIf m = 1 Then
     Select Case i
Case 1:
        bisend(0) = 4 '风速
        bisend(3) = 0
         x = 0
Case 2:
        bisend(0) = 20 'so2
        bisend(3) = 0
         x = 0
Case 3:
        bisend(0) = 21 'no2
        bisend(3) = 0
         x = 0
Case 4:
        bisend(0) = 22 'h2s
        bisend(3) = 0
         x = 0
Case 5:
        bisend(0) = 23 'th
         bisend(3) = 8
          x = 8
Case 6:
        bisend(0) = 23 'th
         bisend(3) = 7
          x = 7
Case Else:
        bisend(0) = 24 'co
         bisend(3) = 0
          x = 0
End Select
i = i + 1
 If i = 8 Then i = 1

        bisend(1) = 3
        bisend(2) = 0
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
         '判断是否连接了，才发送数据
         j = 1
         On Error Resume Next
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
       Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then Winsock1.SendData bisend
  
    ElseIf m = 3 Then
      Select Case i
Case 1:
        bisend(0) = 5 '大气监测
         bisend(3) = 0
          x = 5
Case 2:
         bisend(0) = 30 'co
         bisend(3) = 0
          x = 0
Case 3:
        bisend(0) = 31 'TH
        bisend(3) = 8
         x = 8
Case 4:
        bisend(0) = 31 'TH
        bisend(3) = 7
         x = 7
Case 5:
        bisend(0) = 32 'co2
         bisend(3) = 0
          x = 0
Case Else:
        bisend(0) = 33 'o2
         bisend(3) = 0
          x = 0
End Select
i = i + 1
If i = 7 Then i = 1
        bisend(1) = 3
        bisend(2) = 0
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
         '判断是否连接了，才发送数据
         j = 1
         On Error Resume Next
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
       Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then Winsock1.SendData bisend


         
         
     ElseIf m = 4 Then
       Select Case i
Case 1:
        bisend(0) = 50 'th
                bisend(3) = 8
                 x = 8
Case 2:
        bisend(0) = 50 'th
                bisend(3) = 7
                 x = 7
Case Else:
        bisend(0) = 51 'co
                bisend(3) = 0
                 x = 0
End Select
i = i + 1
If i = 4 Then i = 1

        bisend(1) = 3
        bisend(2) = 0
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
         '判断是否连接了，才发送数据
         j = 1
         On Error Resume Next
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
       Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then Winsock1.SendData bisend

         
      Else
       Select Case i
Case 1:
        bisend(0) = 3 ''大气监测
        bisend(3) = 0
          x = 5
Case 2:
        bisend(0) = 10 'co
        bisend(3) = 0
         x = 0
Case 3:
        bisend(0) = 11 'th
            bisend(3) = 8
             x = 8
Case 4:
        bisend(0) = 11 'th
            bisend(3) = 7
             x = 7
Case 5:
        bisend(0) = 12 'o2
        bisend(3) = 0
         x = 0
Case Else:
        bisend(0) = 13 'co2
        bisend(3) = 0
         x = 0
End Select
i = i + 1
If i = 7 Then i = 1
        bisend(1) = 3
        bisend(2) = 0
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
         '判断是否连接了，才发送数据
         j = 1
         On Error Resume Next
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
       Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then Winsock1.SendData bisend
    End If
    num = bisend(0)
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim a As String
Dim b As String
    Dim myStr() As Byte
    myStr = ""
    strData = ""
    Winsock1.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
     strData2 = "XXXXXX"
     sd = response(strData1)
     wd = "XXXXXX"
    ElseIf x = 7 Then
     Text1.Text = strData
     strData2 = strData
      strData1 = "XXXXXX"
     wd = response(Text1.Text)
     sd = "XXXXXX"
     ElseIf x = 0 Then
      Text1.Text = strData
      strData2 = strData
       strData1 = strData
     wd = response(Text1.Text)
      sd = response(Text1.Text)
        ElseIf x = 5 Then
      Text1.Text = strData
      strData2 = strData
       strData1 = strData
     wd = response(Text1.Text)
      sd = response(Text1.Text)
   End If
If strData2 <> "" And strData1 <> "" Then
Call insert_num(num, strData2, strData1, sd, wd)
End If
Text1.Text = ""
Text2.Text = ""
Timer5_Timer
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

一下是接受的数据：

全部接受完毕，程序运行无问题