?? frmzhenting.frm

?? 這個是用MSCOMM控件編寫的遠程水文監(jiān)測系統(tǒng)
?? FRM
?? 第 1 頁 / 共 2 頁
字號:
上一頁 12
         Shape           =   3  'Circle
         Top             =   600
         Width           =   495
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H0080FF80&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   3
         Left            =   4560
         Shape           =   3  'Circle
         Top             =   600
         Width           =   495
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H0080FF80&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   4
         Left            =   5880
         Shape           =   3  'Circle
         Top             =   600
         Width           =   495
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H0080FF80&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   5
         Left            =   7200
         Shape           =   3  'Circle
         Top             =   600
         Width           =   495
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H0080FF80&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   6
         Left            =   8520
         Shape           =   3  'Circle
         Top             =   600
         Width           =   495
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H0000FF00&
         FillStyle       =   0  'Solid
         Height          =   375
         Index           =   7
         Left            =   9960
         Shape           =   3  'Circle
         Top             =   600
         Width           =   495
      End
   End
   Begin VB.CommandButton CommandQuit 
      Caption         =   "返回"
      Height          =   375
      Left            =   9720
      TabIndex        =   1
      Top             =   3600
      Width           =   1095
   End
   Begin VB.CommandButton CommandDisable 
      Caption         =   "解除警報"
      Enabled         =   0   'False
      Height          =   375
      Left            =   8520
      TabIndex        =   0
      Top             =   3600
      Width           =   1095
   End
End
Attribute VB_Name = "Frmzhenting"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim no As String                '存儲偵聽到的消息為第幾條消息
Dim rs As New ADODB.Recordset
Dim dbcn As New ADODB.Connection
Dim arr_return(40) As Variant   '存儲帶%%的數(shù)據(jù)信息
Dim mess_index() As Variant     '存儲GSM模塊返回的帶有短消息編號的確認信息
Dim message(100) As Variant     '存儲讀取短消息時的所有信息
Dim mess(19) As Variant         '存儲arr_return轉(zhuǎn)化后的信息
Dim Value(11) As Variant        '存儲數(shù)據(jù)轉(zhuǎn)化之后的信息，即最后的數(shù)值
Dim zhuanfa_no As Integer       '記錄偵聽到的第幾號站口,以供轉(zhuǎn)發(fā)時使用
Dim intall As Integer           '在Timer1控件中指示程序的流程，初始值為0
Dim ifalarm As Boolean          '判斷是否報警
Dim strsql As String

Private Sub CommandDisable_Click()
On Error Resume Next
ifalarm = False
intall = 0
End Sub

Private Sub CommandQuit_Click()
Unload Me

End Sub

Private Sub Form_Load()
On Error Resume Next
intall = 0
End Sub


'''''''''''''''''''''''''''執(zhí)行傳來的sql語句
Public Function excutesql(strsql As String)
Dim filename As String
filename = App.Path + "\db\db1.mdb"       '指定數(shù)據(jù)庫文件的位置
dbcn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & filename
dbcn.Open     '連接數(shù)據(jù)庫
  rs.ActiveConnection = dbcn
    rs.Source = strsql
    rs.Open

      
End Function

Private Sub Timer1_Timer()

On Error Resume Next
  If MDIForm1.Comm1.InBufferCount > 0 Then     '檢測端口緩沖區(qū)是否為空
intall = intall + 1            ' Timer控件的間隔時間每到一次，IntAll加1，不同的IntAll
                                '  值進行不同的操作
If intall = 1 Then
         Call readno            ' IntAll為1，即剛開始運行程序，由于緩沖區(qū)端口不為空，調(diào)用
                           'ReadNo函數(shù)，讀取GSM模塊發(fā)給PC機的確認信息中新到短
                       '消息的編號
End If
If intall = 2 Then
         Call getdata           ' IntAll為2，表明已經(jīng)讀取到短消息的編號，由于緩沖區(qū)端口不                                  '為空，調(diào)用GetData 函數(shù)，讀取GSM模塊中的指定編號的短信息
                       ' 對讀取的短消息進行處理，得到有用數(shù)據(jù)，保存入庫，并且刪除
                       ' 該短消息。如果沒有報警則IntAll＝0，從新開始掃描端口。
Call rectemp           '讀取刪除后GSM模塊發(fā)送給PC機的確認信息。
End If
If intall = 4 Then
          Call zhuanfa  'IntAll為4，表明此時有報警現(xiàn)象，轉(zhuǎn)發(fā)報警給有關(guān)的負責人
End If
If intall = 5 Then
         Call sendtxt              'IntAll為5，判斷是否讀取到GSM模塊返回的確認信息中的">"，
                                  '如果讀到，則發(fā)送數(shù)據(jù)信息，沒有讀到，重新轉(zhuǎn)發(fā)。
      End If
      If intall = 8 Then
          If MDIForm1.Comm1.InBufferCount > 0 Then
              Call rectemp          '讀取轉(zhuǎn)發(fā)后，GSM模塊返回的確認信息
               intall = 7
           End If
      End If
      If intall = 9 Then
           If ifalarm Then             ' 判斷是否報警，如果報警，則開始循環(huán)播放報警聲音。
               MMControl1.filename = App.Path + "\alarm1.wav"  '指定要播放的報警聲音
               MMControl1.Command = "Open"                '打開
                 MMControl1.Command = "Play"               '播放
                 intall = 8                            'IntAll=8控制循環(huán)播放
            End If
        End If
End If

End Sub
Public Function getdata()       '從串口讀出消息，從%開始存到數(shù)組arr_return中
On Error Resume Next
Dim Count As Integer           '循環(huán)讀取中用到的計數(shù)器
Dim sum As Integer             '計算校驗和時用到的變量
Dim Flag As Boolean            '判斷讀取的數(shù)據(jù)是否有效
Dim temp As Variant            '臨時變量，存放每次讀取的字符
Count = 0

MDIForm1.Comm1.InputLen = 1
While MDIForm1.Comm1.InBufferCount > 0   '按照字節(jié)循環(huán)讀取緩沖區(qū)
temp = MDIForm1.Comm1.Input
Count = Count + 1
If Hex(Asc(temp)) = Hex(Asc("%")) Then    '判斷讀到的字符是否為"%"
      Flag = True                         '如果是，標志位為true，表明數(shù)據(jù)有效
End If
 If Flag = True Then
   arr_return(Count - 1) = Asc(temp)      '以%%開頭的數(shù)據(jù)存入數(shù)組中
 End If
Wend
If Flag = True Then
   For Count = 2 To 20
      mess(Count - 2) = arr_return(Count) '把數(shù)組arr_return的有用數(shù)據(jù)存入mess數(shù)組
   Next
   sum = 0
   For Count = 0 To 17                    '循環(huán)取得所有數(shù)據(jù)的和
      sum = sum + mess(Count)
   Next
   sum = sum Mod 128                        '取得校驗和
      
   If sum = mess(18) Then                 '判斷校驗和與校驗位是否相等，如果相等，按照數(shù)據(jù)
                                          '協(xié)議，合并得到最終數(shù)據(jù)
      Value(0) = mess(0)
      Value(1) = mess(1) * 100 + mess(2)
      Value(2) = mess(3) * 100 + mess(4)
      Value(3) = mess(5) * 100 + mess(6)
      Value(4) = mess(7) * 100 + mess(8)
      Value(5) = mess(9) * 100 + mess(10)
      Value(6) = mess(11) * 100 + mess(12)
      Value(7) = mess(13) * 100 + mess(14)
      Value(8) = mess(15) * 100 + mess(16)
      Value(9) = mess(17)
      Value(10) = mess(18)
      Call savedata                     '調(diào)用savedata函數(shù)保存數(shù)據(jù)
    Else
       MsgBox "對不起，收到信息中的校驗和不正確！", vbOKOnly, "通知"
                                        '校驗和不正確，提示出錯
    End If
Else
    intall = 1                          '數(shù)據(jù)無效，重新讀取
End If
End Function

Public Function savedata()       ''''保存取得的數(shù)據(jù)信息到數(shù)據(jù)庫
On Error Resume Next
Dim state As String            '保存遠端設(shè)備工作狀態(tài)
Dim tel As String              '遠端設(shè)備的手機號
Dim time As String             '接收到數(shù)據(jù)的時間
Dim time1 As Date              '把時間轉(zhuǎn)換成Date類型
Dim id As String               '遠端設(shè)備的編號
Dim name As String             '遠端設(shè)備的名字
Dim j As Integer
strsql = "select * from state where state_no =" & Value(0) & ""
                             '根據(jù)狀態(tài)碼從數(shù)據(jù)庫中取得對應(yīng)的事件，存在state變量中
excutesql (strsql)
state = rs!state_name
rs.Close
dbcn.Close
                             '根據(jù)GSM模塊返回的確認信息，從中取得遠端設(shè)備的手機號和發(fā)送時間
For j = 0 To UBound(message) - 34
If message(j) = "+" And message(j + 1) = "8" And message(j + 2) = "6" Then
    tel = message(j + 3) + message(j + 4) + message(j + 5) + message(j + 6) + message(j + 7) + message(j + 8) + message(j + 9) + message(j + 10) + message(j + 11) + message(j + 12) + message(j + 13)
     time = message(j + 18) + message(j + 19) + message(j + 20) + message(j + 21) + message(j + 22) + message(j + 23) + message(j + 24) + message(j + 25) + Space(1) + message(j + 27) + message(j + 28) + message(j + 29) + message(j + 30) + message(j + 31) + message(j + 32) + message(j + 33) + message(j + 34)
time1 = CDate(time)
End If
Next

                            '根據(jù)手機號從數(shù)據(jù)庫中取得遠端設(shè)備信息：編號，名字
strsql = "select * from zhankou where tel= '" & tel & "'"
excutesql (strsql)
id = rs!id
name = rs!name
rs.Close
dbcn.Close
                               '將數(shù)據(jù)存儲到數(shù)據(jù)庫中
Select Case state              '根據(jù)狀態(tài)碼的不同，執(zhí)行不同的操作
 Case "該站點完成初始化，進入正常運行"
     ifalarm = False
     strsql = "update zhankou set ifactive=1"   '標記遠端設(shè)備為當前活動的遠端設(shè)備
     excutesql (strsql)
 Case "校驗和錯誤"
     ifalarm = True
     MsgBox rs!id & "號站口電流電壓值設(shè)定失敗！", vbOKOnly, "通知"
 Case "工作正常", "電壓恢復(fù)正常", "A相恢復(fù)正常", "B相恢復(fù)正常", "C相恢復(fù)正常", "1路電流源恢復(fù)正常", "2路電流源恢復(fù)正常", "3路電流源恢復(fù)正常", "4路電流源恢復(fù)正常"
                    '遠端設(shè)備工作正常
    ifalarm = False
   
    strsql = "INSERT INTO data VALUES(" & CInt(id) & ", '" & name & "', '" & time1 & "', '" & state & "', " & Value(1) & ", " & Value(2) & ", " & Value(3) & ", " & Value(4) & ", " & Value(5) & ", " & Value(6) & ", " & Value(7) & ", " & Value(8) & ");"
    excutesql (strsql)                  '保存數(shù)據(jù)
     Tno.Text = id                      '在窗口中顯示接收到的數(shù)據(jù)
     Ttime.Text = time1
     Tname.Text = name
     Tevent.Text = state
     Tv.Text = Value(1)
     Ta.Text = Value(2)
     Tb.Text = Value(3)
     Tc.Text = Value(4)
     Ta1.Text = Value(5)
     Ta2.Text = Value(6)
     Ta3.Text = Value(7)
     Ta4.Text = Value(8)
     Call ConvertBin                   '調(diào)用十進制轉(zhuǎn)換二進制的函數(shù)，用來分析I/O的各個端口狀態(tài)
Case Else
                                '遠端設(shè)備工作不正常
    ifalarm = True
    strsql = "INSERT INTO data VALUES(" & CInt(id) & ", '" & name & "', '" & time1 & "', '" & state & "', " & Value(1) & ", " & Value(2) & ", " & Value(3) & ", " & Value(4) & ", " & Value(5) & ", " & Value(6) & ", " & Value(7) & ", " & Value(8) & ");"
    excutesql (strsql)                   '保存數(shù)據(jù)
    GurhanButton1.Enabled = True         '激活解除警報按鈕
     Tno.Text = id                       '顯示數(shù)據(jù)
     Ttime.Text = time1
     Tname.Text = name
     Tevent.Text = state
     Tv.Text = Value(1)
     Ta.Text = Value(2)
     Tb.Text = Value(3)
     Tc.Text = Value(4)
     Ta1.Text = Value(5)
     Ta2.Text = Value(6)
     Ta3.Text = Value(7)
     Ta4.Text = Value(8)
     Call ConvertBin                     '調(diào)用十進制轉(zhuǎn)換二進制的函數(shù)，用來分析I/O的各個端口狀態(tài)
End Select
     Set rs = Nothing
     dbcn.Close
     zhuanfa_no = CInt(id)
     MDIForm1.Comm1.Output = "AT+CMGD=" + no + Chr(13) + Chr(10)
If ifalarm = False Then               '沒有報警，則重新開始掃描端口
  intall = 0
End If
 
Dim m As Integer               '清空數(shù)組內(nèi)容
For m = 0 To 18
mess(m) = 0
Next
For m = 0 To 10
Value(m) = 0
Next

End Function

Public Function sendtxt()
On Error Resume Next
Dim Buf$
Dim ChrErr As String
Dim LastCh As String
If MDIForm1.Comm1.InBufferCount > 0 Then

  MDIForm1.Comm1.InputLen = 0
  Buf = Trim(MDIForm1.Comm1.Input)
  ChrErr = Right(Left(Buf, 5), 1)  '取得緩沖區(qū)的倒數(shù)第四個字符，存入變量ChrErr中
  LastCh = Right(Buf, 1)           '取得緩沖區(qū)的最后一個字符，存入變量LastCh中
  If ChrErr = "E" Then             '判斷是否為E，是則代表返回信息為Error,重新發(fā)送AT命令
     strsql = "select * from renyuan "
     excutesql (strsql)
     MDIForm1.Comm1.Output = "AT+CMGS=" + rs!tel + Chr(13) + Chr(13) + Chr(10)
     intall = 4
     Set rs = Nothing
     dbcn.Close
  End If
  If LastCh = ">" Then
      MDIForm1.Comm1.Output = "The no." & zhuanfa_no & " have somthing wrong in the I/O " + Chr(26)
                         '如果最后一個字符為">",則發(fā)送報警消息給相關(guān)負責人
  End If
End If


End Function


Public Function rectemp()
Dim Buf$
If MDIForm1.Comm1.InBufferCount > 0 Then
MDIForm1.Comm1.InputLen = 0             'Comm1控件的InputLen屬性設(shè)為0，代表把緩沖區(qū)中所
                                   '有內(nèi)容一次全部讀出。
Buf = MDIForm1.Comm1.Input
End If

End Function
Public Function ConvertBin()
On Error Resume Next
    Dim IntIO As Integer           'IO端口的數(shù)據(jù)
    Dim Count As Integer
    Dim BinArray(7) As Integer     '存放對應(yīng)字節(jié)的數(shù)據(jù)
        IntIO = Value(9)
        BinArray(7) = IntIO Mod 2  '
        IntIO = IntIO \ 2
        BinArray(6) = IntIO Mod 2
        IntIO = IntIO \ 2
        BinArray(5) = IntIO Mod 2
        IntIO = IntIO \ 2
        BinArray(4) = IntIO Mod 2
        IntIO = IntIO \ 2
        BinArray(3) = IntIO Mod 2
        IntIO = IntIO \ 2
        BinArray(2) = IntIO Mod 2
        IntIO = IntIO \ 2
        BinArray(1) = IntIO Mod 2
        IntIO = IntIO \ 2
        BinArray(0) = IntIO Mod 2
        
        For Count = 0 To UBound(BinArray)
            If BinArray(Count) = 1 Then  '端口數(shù)據(jù)為1的端口對應(yīng)的Shape控件顏色變紅報警
               Shape1(Count).FillColor = &H8080FF
               Else
               Shape1(Count).FillColor = &H80FF80
               End If
        Next
        
    
End Function

''''''''''''''''''''''讀取偵聽到的短消息的號碼
Public Function readno()
On Error Resume Next
If MDIForm1.Comm1.InBufferCount > 0 Then
Dim Count As Integer
Count = 0
MDIForm1.Comm1.InputLen = 1                 '按照字節(jié)循環(huán)讀取緩沖區(qū)中的信息
   While MDIForm1.Comm1.InBufferCount > 0
     ReDim Preserve mess_index(Count + 1)   '動態(tài)定義數(shù)組的大小
     mess_index(Count) = Hex(Asc(MDIForm1.Comm1.Input))  '把字符型數(shù)據(jù)轉(zhuǎn)換為16進制數(shù)
            Count = Count + 1
   Wend
   Count = UBound(mess_index)               '取數(shù)組的上限
     no = Val("&H" + mess_index(Count - 3))  '取短消息的編號，它位于整個緩沖區(qū)的倒數(shù)第三個字符
      MDIForm1.Comm1.Output = "AT+CMGR=" & no & "" + Chr(13) + Chr(10)
                                             '按照編號發(fā)送命令讀取短消息
 End If
     
       

End Function
Public Function zhuanfa()
'''''''''''''''''''''''''''''''轉(zhuǎn)發(fā)信息
strsql = "select * from renyuan "
excutesql (strsql)
MDIForm1.Comm1.Output = "AT+CMGS=" + rs!tel + Chr(13) + Chr(13) + Chr(10)
Set rs = Nothing
dbcn.Close
End Function
上一頁 12
?? 文件大小 317 K
?? 上傳用戶 foreverxiluzai
?? 所屬分類串口編程
??? 相關(guān)標簽

#MSCOMM #控件 #編寫 #水文監(jiān)測
?? 快捷鍵說明

復(fù)制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? frmzhenting.frm

?? 快捷鍵說明
