1. 程式人生 > >應用於實踐的vb socket讀取感測器溫溼度

應用於實踐的vb socket讀取感測器溫溼度

背景: 應付於基站可能癱瘓的情況,讀取溫溼度並且儲存到資料庫中

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 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)
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
Winsock1.Close '關閉當前套接字
End Sub
Private Sub Form_Load()
Dim s As Integer
On Error Resume Next
m = 0
i = 1
Timer6.Enabled = True
Timer6.Interval = 30000
End Sub
Private Sub Socket()
Dim j As Long
Winsock1.Close
m = m + 1
On Error Resume Next
Select Case m
i = 1
Case 1: Winsock1.LocalPort = 6040
        Winsock1.Listen
Case 2: Winsock1.LocalPort = 6041
        Winsock1.Listen
Case 3: Winsock1.LocalPort = 6042
        Winsock1.Listen
Case 4: Winsock1.LocalPort = 6043
        Winsock1.Listen
Case Else:
        Winsock1.LocalPort = 6044
        Winsock1.Listen
End Select
If m = 5 Then m = 0
'如果埠沒有的話怎麼辦
 '判斷是否連線了,才傳送資料
        Timer5.Enabled = True
        Timer5.Interval = 3000
End Sub
Private Sub Timer6_Timer()
'總共是5個埠下面多個感測器
Socket
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal RequestID As Long)
Dim myStr As String
    If Winsock1.State <> sckClosed Then
            Winsock1.Close
            Winsock1.Accept RequestID
    End If
End Sub
Private Sub Timer5_Timer()
'Timer5.Enabled = False
x = 8
 '獲取溫度測試串
    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
Case 2:
        bisend(0) = 40
Case 3:
        bisend(0) = 41
Case 4:
        bisend(0) = 42
Case 5:
        bisend(0) = 43
Case 6:
        bisend(0) = 44
Case Else:
        bisend(0) = 45
End Select
i = i + 1
 If i = 8 Then
 i = 1
 End If
        bisend(1) = 3
        bisend(2) = 0
        bisend(3) = 8
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
         '判斷是否連線了,才傳送資料
         j = 1
         Do Until Winsock1.State = 7 Or j > 600
         j = j + 1
         DoEvents
         Call Sleep(3)
         Loop
        If j >= 600 Or Winsock1.State = 7 Then
      ' 1分鐘後,對方仍然未同意,連線超時.
        End If
        Winsock1.SendData bisend
        
        
    ElseIf m = 1 Then
    
     Select Case i
Case 1:
        bisend(0) = 4
Case 2:
        bisend(0) = 20
Case 3:
        bisend(0) = 21
Case 4:
        bisend(0) = 22
Case 5:
        bisend(0) = 23
Case Else:
        bisend(0) = 24
End Select
i = i + 1
 If i = 7 Then
 i = 1
 End If
        bisend(1) = 3
        bisend(2) = 0
        bisend(3) = 8
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
        '判斷是否連線了,才傳送資料
        j = 1
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
        Call Sleep(3)
        Loop
          If j >= 600 Or Winsock1.State = 7 Then
    ' 1分鐘後,對方仍然未同意,連線超時.
          End If
          
        Winsock1.SendData bisend

    
     ElseIf m = 3 Then
      Select Case i
Case 1:
        bisend(0) = 5
Case 2:
        bisend(0) = 30
Case 3:
        bisend(0) = 31
Case 4:
        bisend(0) = 32
Case Else:
        bisend(0) = 33
End Select
i = i + 1
If i = 6 Then
i = 1
End If
        bisend(1) = 3
        bisend(2) = 0
        bisend(3) = 8
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
        '判斷是否連線了,才傳送資料
        j = 1
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
       Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then
    ' 1分鐘後,對方仍然未同意,連線超時.
        j = j
        End If
        Winsock1.SendData bisend

         
         
      ElseIf m = 4 Then
       Select Case i
Case 1:
        bisend(0) = 50
Case Else:
        bisend(0) = 51
End Select
i = i + 1
If i = 3 Then
i = 1
End If
        bisend(1) = 3
        bisend(2) = 0
        bisend(3) = 8
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
        '判斷是否連線了,才傳送資料
        j = 1
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
        Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then
    ' 1分鐘後,對方仍然未同意,連線超時
        j = j
        End If
        On Error Resume Next
        Winsock1.SendData bisend

         
      Else
       Select Case i
Case 1:
        bisend(0) = 3
Case 2:
        bisend(0) = 10
Case 3:
        bisend(0) = 11
Case 4:
        bisend(0) = 12
Case Else:
        bisend(0) = 13
End Select
i = i + 1
If i = 6 Then
i = 1
End If
        bisend(1) = 3
        bisend(2) = 0
        bisend(3) = 8
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
        '判斷是否連線了,才傳送資料
         j = 1
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
       Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then
    ' 1分鐘後,對方仍然未同意,連線超時.
        End If
         On Error Resume Next
        Winsock1.SendData bisend
    End If
    num = bisend(0)
End Sub
Private Sub Humid(m As Integer)
Dim s As Integer
Dim j As Long
 '獲取溼度測試串
 x = 7
    strData2 = ""
    Dim bisend(7) As Byte
    Dim crc
    Dim btLoCRC As Byte, btHiCRC As Byte
    Dim Data As Integer
    If m = 2 Then
Select Case i
Case 1:
        bisend(0) = 6
Case 2:
        bisend(0) = 40
Case 3:
        bisend(0) = 41
Case 4:
        bisend(0) = 42
Case 5:
        bisend(0) = 43
Case 6:
        bisend(0) = 44
Case Else:
        bisend(0) = 45
End Select
i = i + 1
If i = 8 Then
i = 1
End If
        bisend(1) = 3
        bisend(2) = 0
        bisend(3) = 7
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
         '判斷是否連線了,才傳送資料
         j = 1
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
       Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then
    ' 1分鐘後,對方仍然未同意,連線超時.
       End If
         Winsock1.SendData bisend
         
     ElseIf m = 1 Then
     Select Case i
Case 1:
        bisend(0) = 4
Case 2:
        bisend(0) = 20
Case 3:
        bisend(0) = 21
Case 4:
        bisend(0) = 22
Case 5:
        bisend(0) = 23
Case Else:
        bisend(0) = 24
End Select
i = i + 1
If i = 7 Then
i = 1
End If
        bisend(1) = 3
        bisend(2) = 0
        bisend(3) = 7
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
         '判斷是否連線了,才傳送資料
         j = 1
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
       Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then
    ' 1分鐘後,對方仍然未同意,連線超時.
    End If
         Winsock1.SendData bisend
         
         
      ElseIf m = 3 Then
      Select Case i
Case 1:
        bisend(0) = 5
Case 2:
        bisend(0) = 30
Case 3:
        bisend(0) = 31
Case 4:
        bisend(0) = 32
Case Else:
        bisend(0) = 33
End Select
i = i + 1
If i = 6 Then
i = 1
End If
        bisend(1) = 3
        bisend(2) = 0
        bisend(3) = 7
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
         '判斷是否連線了,才傳送資料
         j = 1
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
       Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then
    ' 1分鐘後,對方仍然未同意,連線超時.
     End If
        Winsock1.SendData bisend
        
        
      ElseIf m = 4 Then
       Select Case i
Case 1:
        bisend(0) = 50
Case Else:
        bisend(0) = 51
End Select
i = i + 1
If i = 3 Then
i = 1
End If
        bisend(1) = 3
        bisend(2) = 0
        bisend(3) = 7
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
         '判斷是否連線了,才傳送資料
         j = 1
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
       Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then
    ' 1分鐘後,對方仍然未同意,連線超時.
    End If
        Winsock1.SendData bisend
        
        
        Else
       Select Case i
Case 1:
        bisend(0) = 3
Case 2:
        bisend(0) = 10
Case 3:
        bisend(0) = 11
Case 4:
        bisend(0) = 12
Case Else:
        bisend(0) = 13
End Select
i = i + 1
If i = 6 Then
i = 1
End If
        bisend(1) = 3
        bisend(2) = 0
        bisend(3) = 7
        bisend(4) = 0
        bisend(5) = 1
        crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
        bisend(6) = btLoCRC
        bisend(7) = btHiCRC
         '判斷是否連線了,才傳送資料
         j = 1
        Do Until Winsock1.State = 7 Or j > 600
        j = j + 1
        DoEvents
       Call Sleep(3)
        Loop
        If j >= 600 Or Winsock1.State = 7 Then
    ' 1分鐘後,對方仍然未同意,連線超時.
     End If
        Winsock1.SendData bisend
        
        
        End If
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
    Print "溼度:" & strData
     Print "溼度:" & Text2.Text
     sd = response(strData1)
     Print "xxxxxxx:" & sd
     Humid m
    ElseIf x = 7 Then
     Text1.Text = strData
     strData2 = strData
     wd = response(Text1.Text)
   End If
If Text1.Text <> "" And Text2.Text <> "" And strData2 <> "" And strData1 <> "" Then
Call insert_num(num, 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