frmqinfqiu.frm

远程水文监测系统 利用vb通信实现远程监控功能。

Private Sub GurhanButton2_Click()
Unload Me

End Sub
Public Function excutesql(strsql As String)
filename = App.Path + "\db\db1.mdb"
dbcn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & filename
dbcn.Open
rs.ActiveConnection = dbcn
    rs.Source = strsql
    rs.Open
End Function

Private Sub Timer1_Timer()
intall = intall + 1
If intall = 1 Then
 Call sendcom                              '首先发送命令字为请求数据的命令
 End If
If intall = 3 Then                        '其余部分同自动接收数据相同
 Call readno
 End If
If intall = 4 Then
  Call getdata
    Call rectemp
End If
If intall = 5 Then
  Call zhuanfa
End If
If intall = 6 Then
  Call sendtxt
  End If
  If intall = 9 Then
   If MDIForm1.Comm1.InBufferCount > 0 Then
     Call rectemp
     intall = 8
  End If
  End If
  If intall = 10 Then
  If ifalarm Then
   MMControl1.filename = App.Path + "\alarm1.wav"
   MMControl1.Command = "Open"
   MMControl1.Command = "Play"
   intall = 9
   End If
 End If
MsgBox "请求的数据已经得到！", vbOKOnly, "通知"
End Sub
''''''''''''''''''''''读取侦听到的短消息的号码
Public Function readno()
On Error Resume Next
If MDIForm1.Comm1.InBufferCount > 0 Then
Dim Count As Integer
Count = 0
MDIForm1.Comm1.InputLen = 1                 '按照字节循环读取缓冲区中的信息
   While MDIForm1.Comm1.InBufferCount > 0
     ReDim Preserve mess_index(Count + 1)   '动态定义数组的大小
     mess_index(Count) = Hex(Asc(MDIForm1.Comm1.Input))  '把字符型数据转换为16进制数
            Count = Count + 1
   Wend
   Count = UBound(mess_index)               '取数组的上限
     no = Val("&H" + mess_index(Count - 3))  '取短消息的编号，它位于整个缓冲区的倒数第三个字符
      MDIForm1.Comm1.Output = "AT+CMGR=" & no & "" + Chr(13) + Chr(10)
                                             '按照编号发送命令读取短消息
 
End If
 
End Function
Public Function getdata()       '从串口读出消息，从%开始存到数组arr_return中
On Error Resume Next
Dim Count As Integer           '循环读取中用到的计数器
Dim sum As Integer             '计算校验和时用到的变量
Dim Flag As Boolean            '判断读取的数据是否有效
Dim temp As Variant            '临时变量，存放每次读取的字符
Count = 0

MDIForm1.Comm1.InputLen = 1
While MDIForm1.Comm1.InBufferCount > 0   '按照字节循环读取缓冲区
temp = MDIForm1.Comm1.Input
Count = Count + 1
If Hex(Asc(temp)) = Hex(Asc("%")) Then    '判断读到的字符是否为"%"
      Flag = True                         '如果是，标志位为true，表明数据有效
End If
 If Flag = True Then
   arr_return(Count - 1) = Asc(temp)      '以%%开头的数据存入数组中
 End If
Wend
If Flag = True Then
   For Count = 2 To 20
      mess(Count - 2) = arr_return(Count) '把数组arr_return的有用数据存入mess数组
   Next
   sum = 0
   For Count = 0 To 17                    '循环取得所有数据的和
      sum = sum + mess(Count)
   Next
   sum = sum Mod 128                        '取得校验和
      
   
   If sum = mess(18) Then                 '判断校验和与校验位是否相等，如果相等，按照数据
                                          '协议，合并得到最终数据
      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                     '调用savedata函数保存数据
    Else
       MsgBox "对不起，收到信息中的校验和不正确！", vbOKOnly, "通知"
                                        '校验和不正确，提示出错
    End If
Else
    intall = 1                          '数据无效，重新读取
End If
End Function
Public Function savedata()       ''''保存取得的数据信息到数据库
On Error Resume Next
Dim state As String            '保存远端设备工作状态
Dim tel As String              '远端设备的手机号
Dim time As String             '接收到数据的时间
Dim time1 As Date              '把时间转换成Date类型
Dim id As String               '远端设备的编号
Dim name As String             '远端设备的名字
Dim j As Integer
strsql = "select * from state where state_no =" & Value(0) & ""
                             '根据状态码从数据库中取得对应的事件，存在state变量中
excutesql (strsql)
state = rs!state_name
rs.Close
dbcn.Close
                             '根据GSM模块返回的确认信息，从中取得远端设备的手机号和发送时间
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

                            '根据手机号从数据库中取得远端设备信息：编号，名字
strsql = "select * from zhankou where tel= '" & tel & "'"
excutesql (strsql)
id = rs!id
name = rs!name
rs.Close
dbcn.Close
                               '将数据存储到数据库中
Select Case state              '根据状态码的不同，执行不同的操作
 Case "该站点完成初始化，进入正常运行"
     ifalarm = False
     strsql = "update zhankou set ifactive=1"   '标记远端设备为当前活动的远端设备
     excutesql (strsql)
 Case "校验和错误"
     ifalarm = True
     MsgBox rs!id & "号站口电流电压值设定失败！", vbOKOnly, "通知"
 Case "工作正常", "电压恢复正常", "A相恢复正常", "B相恢复正常", "C相恢复正常", "1路电流源恢复正常", "2路电流源恢复正常", "3路电流源恢复正常", "4路电流源恢复正常"
                    '远端设备工作正常
    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)                  '保存数据
     Tno.Text = id                      '在窗口中显示接收到的数据
     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                   '调用十进制转换二进制的函数，用来分析I/O的各个端口状态
Case Else
                                '远端设备工作不正常
    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)                   '保存数据
    GurhanButton1.Enabled = True         '激活解除警报按钮
     Tno.Text = id                       '显示数据
     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                     '调用十进制转换二进制的函数，用来分析I/O的各个端口状态
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               '清空数组内容
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)  '取得缓冲区的倒数第四个字符，存入变量ChrErr中
  LastCh = Right(Buf, 1)           '取得缓冲区的最后一个字符，存入变量LastCh中
  If ChrErr = "E" Then             '判断是否为E，是则代表返回信息为Error,重新发送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)
                         '如果最后一个字符为">",则发送报警消息给相关负责人
  End If
End If


End Function


Public Function rectemp()
Dim Buf$
If MDIForm1.Comm1.InBufferCount > 0 Then
MDIForm1.Comm1.InputLen = 0
Buf = MDIForm1.Comm1.Input

End If
End Function
Public Function ConvertBin()
On Error Resume Next
    Dim IntIO As Integer           'IO端口的数据
    Dim Count As Integer
    Dim BinArray(7) As Integer     '存放对应字节的数据
        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  '端口数据为1的端口对应的Shape控件颜色变红报警
               Shape1(Count).FillColor = &H8080FF
               Else
               Shape1(Count).FillColor = &H80FF80
               End If
        Next
        
    
End Function
Public Function sendcom()
On Error Resume Next
Dim Buf$
Dim LastChr As String
 
If MDIForm1.Comm1.InBufferCount > 0 Then
  MDIForm1.Comm1.InputLen = 0    '将缓冲区中的信息全部读出
 
  Buf = Trim(MDIForm1.Comm1.Input)
  LastChr = Right(Buf, 1)        '取缓冲区的最后一个字符
  If LastChr = ">" Then
      MDIForm1.Comm1.Output = "%%" + Chr(0) + Chr(0) + Chr(0) + Chr(0) + "%" + Chr(26)
                                  '向远端设备发送命令，命令字为0，即请求数据
  Else
     Timer1.Enabled = False
     intall = 0
     Call CommandAsk_Click        '如果最后一个字符不是">"，则重新开始发送AT指令
  End If
Else
    intall = 0
End If
End Function
Public Function zhuanfa()
'''''''''''''''''''''''''''''''转发信息
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