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

一下是接受的數據:

全部接受完畢,程序運行無問題

 

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章