📄 frmzhenting.frm
字号:
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 '存储带%%的数据信息
Dim mess_index() As Variant '存储GSM模块返回的带有短消息编号的确认信息
Dim message(100) As Variant '存储读取短消息时的所有信息
Dim mess(19) As Variant '存储arr_return转化后的信息
Dim Value(11) As Variant '存储数据转化之后的信息，即最后的数值
Dim zhuanfa_no As Integer '记录侦听到的第几号站口,以供转发时使用
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
'''''''''''''''''''''''''''执行传来的sql语句
Public Function excutesql(strsql As String)
Dim filename 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()
On Error Resume Next
If MDIForm1.Comm1.InBufferCount > 0 Then '检测端口缓冲区是否为空
intall = intall + 1 ' Timer控件的间隔时间每到一次，IntAll加1，不同的IntAll
' 值进行不同的操作
If intall = 1 Then
Call readno ' IntAll为1，即刚开始运行程序，由于缓冲区端口不为空，调用
'ReadNo函数，读取GSM模块发给PC机的确认信息中新到短
'消息的编号
End If
If intall = 2 Then
Call getdata ' IntAll为2，表明已经读取到短消息的编号，由于缓冲区端口不 '为空，调用GetData 函数，读取GSM模块中的指定编号的短信息
' 对读取的短消息进行处理，得到有用数据，保存入库，并且删除
' 该短消息。如果没有报警则IntAll＝0，从新开始扫描端口。
Call rectemp '读取删除后GSM模块发送给PC机的确认信息。
End If
If intall = 4 Then
Call zhuanfa 'IntAll为4，表明此时有报警现象，转发报警给有关的负责人
End If
If intall = 5 Then
Call sendtxt 'IntAll为5，判断是否读取到GSM模块返回的确认信息中的">"，
'如果读到，则发送数据信息，没有读到，重新转发。
End If
If intall = 8 Then
If MDIForm1.Comm1.InBufferCount > 0 Then
Call rectemp '读取转发后，GSM模块返回的确认信息
intall = 7
End If
End If
If intall = 9 Then
If ifalarm Then ' 判断是否报警，如果报警，则开始循环播放报警声音。
MMControl1.filename = App.Path + "\alarm1.wav" '指定要播放的报警声音
MMControl1.Command = "Open" '打开
MMControl1.Command = "Play" '播放
intall = 8 'IntAll=8控制循环播放
End If
End If
End If
End Sub
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 '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 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 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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -