Dim cn1 As New ADODB.Connection
Dim cn2 As New ADODB.Connection
Dim cn3 As New ADODB.Connection
Dim cn4 As New ADODB.Connection
Dim cn5 As New ADODB.Connection
Dim cn6 As New ADODB.Connection
Dim cn7 As New ADODB.Connection
Dim cn8 As New ADODB.Connection
Dim cn9 As New ADODB.Connection
Dim cn10 As New ADODB.Connection
Dim cn11 As New ADODB.Connection
Dim cn12 As New ADODB.Connection
Dim cn13 As New ADODB.Connection
Dim cn14 As New ADODB.Connection
Dim cn15 As New ADODB.Connection
Dim cn16 As New ADODB.Connection
Dim cn17 As New ADODB.Connection
Dim cn18 As New ADODB.Connection
Dim cn19 As New ADODB.Connection
Dim cn20 As New ADODB.Connection
'删除记录时,所需的连接
Dim connDest1 As New ADODB.Connection
Dim connDest2 As New ADODB.Connection
Dim connDest3 As New ADODB.Connection
Dim connDest4 As New ADODB.Connection
Dim connDest5 As New ADODB.Connection
Dim connDest6 As New ADODB.Connection
Dim connDest7 As New ADODB.Connection
Dim connDest8 As New ADODB.Connection
Dim connDest9 As New ADODB.Connection
Dim connDest10 As New ADODB.Connection
Dim connDest11 As New ADODB.Connection
Dim connDest12 As New ADODB.Connection
Dim connDest13 As New ADODB.Connection
Dim connDest14 As New ADODB.Connection
Dim connDest15 As New ADODB.Connection
Dim connDest16 As New ADODB.Connection
Dim connDest17 As New ADODB.Connection
Dim connDest18 As New ADODB.Connection
Dim connDest19 As New ADODB.Connection
Dim connDest20 As New ADODB.Connection
'每10S存数
Dim rs1_1 As New ADODB.Recordset
Dim rs1_2 As New ADODB.Recordset
Dim rs1_3 As New ADODB.Recordset
Dim rs1_4 As New ADODB.Recordset
Dim rs1_5 As New ADODB.Recordset
Dim rs1_6 As New ADODB.Recordset
Dim rs1_7 As New ADODB.Recordset
Dim rs1_8 As New ADODB.Recordset
Dim rs1_9 As New ADODB.Recordset
Dim rs1_10 As New ADODB.Recordset
Dim rs1_11 As New ADODB.Recordset
Dim rs1_12 As New ADODB.Recordset
Dim rs1_13 As New ADODB.Recordset
Dim rs1_14 As New ADODB.Recordset
Dim rs1_15 As New ADODB.Recordset
Dim rs1_16 As New ADODB.Recordset
Dim rs1_17 As New ADODB.Recordset
Dim rs1_18 As New ADODB.Recordset
Dim rs1_19 As New ADODB.Recordset
Dim rs1_20 As New ADODB.Recordset
'每分钟存数
Dim rs7_1 As New ADODB.Recordset
Dim rs7_2 As New ADODB.Recordset
Dim rs7_3 As New ADODB.Recordset
Dim rs7_4 As New ADODB.Recordset
Dim rs7_5 As New ADODB.Recordset
Dim rs7_6 As New ADODB.Recordset
Dim rs7_7 As New ADODB.Recordset
Dim rs7_8 As New ADODB.Recordset
Dim rs7_9 As New ADODB.Recordset
Dim rs7_10 As New ADODB.Recordset
Dim rs7_11 As New ADODB.Recordset
Dim rs7_12 As New ADODB.Recordset
Dim rs7_13 As New ADODB.Recordset
Dim rs7_14 As New ADODB.Recordset
Dim rs7_15 As New ADODB.Recordset
Dim rs7_16 As New ADODB.Recordset
Dim rs7_17 As New ADODB.Recordset
Dim rs7_18 As New ADODB.Recordset
Dim rs7_19 As New ADODB.Recordset
Dim rs7_20 As New ADODB.Recordset
'每10分钟存数
Dim rs30_1 As New ADODB.Recordset
Dim rs30_2 As New ADODB.Recordset
Dim rs30_3 As New ADODB.Recordset
Dim rs30_4 As New ADODB.Recordset
Dim rs30_5 As New ADODB.Recordset
Dim rs30_6 As New ADODB.Recordset
Dim rs30_7 As New ADODB.Recordset
Dim rs30_8 As New ADODB.Recordset
Dim rs30_9 As New ADODB.Recordset
Dim rs30_10 As New ADODB.Recordset
Dim rs30_11 As New ADODB.Recordset
Dim rs30_12 As New ADODB.Recordset
Dim rs30_13 As New ADODB.Recordset
Dim rs30_14 As New ADODB.Recordset
Dim rs30_15 As New ADODB.Recordset
Dim rs30_16 As New ADODB.Recordset
Dim rs30_17 As New ADODB.Recordset
Dim rs30_18 As New ADODB.Recordset
Dim rs30_19 As New ADODB.Recordset
Dim rs30_20 As New ADODB.Recordset
'每天存数
Dim rsYear_1 As New ADODB.Recordset
Dim rsYear_2 As New ADODB.Recordset
Dim rsYear_3 As New ADODB.Recordset
Dim rsYear_4 As New ADODB.Recordset
Dim rsYear_5 As New ADODB.Recordset
Dim rsYear_6 As New ADODB.Recordset
Dim rsYear_7 As New ADODB.Recordset
Dim rsYear_8 As New ADODB.Recordset
Dim rsYear_9 As New ADODB.Recordset
Dim rsYear_10 As New ADODB.Recordset
Dim rsYear_11 As New ADODB.Recordset
Dim rsYear_12 As New ADODB.Recordset
Dim rsYear_13 As New ADODB.Recordset
Dim rsYear_14 As New ADODB.Recordset
Dim rsYear_15 As New ADODB.Recordset
Dim rsYear_16 As New ADODB.Recordset
Dim rsYear_17 As New ADODB.Recordset
Dim rsYear_18 As New ADODB.Recordset
Dim rsYear_19 As New ADODB.Recordset
Dim rsYear_20 As New ADODB.Recordset
Dim TempNum As Integer '连接探测器个数
Dim num As Integer
Dim Flg As Integer '标记--第一次获取实时值时,应该进行的操作
Dim FlgTime As String '标记--第一次获取实时值的时间
Dim FlgTimeMin As String '标记--上次获取每10分钟实时值的时间
Dim FlgTimeSeconds As String
Dim value1 As Single
Dim value2 As Single
Dim value3 As Single
Dim value4 As Single
Dim value5 As Single
Dim value6 As Single
Dim value7 As Single
Dim value8 As Single
Dim value9 As Single
Dim value10 As Single
Dim value11 As Single
Dim value12 As Single
Dim value13 As Single
Dim value14 As Single
Dim value15 As Single
Dim value16 As Single
Dim value17 As Single
Dim value18 As Single
Dim value19 As Single
Dim value20 As Single
Dim temp As Integer '仪表号循环变量
Dim Noise(19) As Byte
Dim FlagNoise As Integer '消音标记
Dim FlagParam As Integer 'FlagParam=1,读参数值; FlagParam=0,读测量值; FlagParam=2,写入参数值
Dim ReceiveData As Single '实时测量值
Dim Receive(3) As Byte '实时测量值
Dim Strdata As String '接收到的实时测量值的字符串
Dim StrdataParameter As String '接收到的参数值的字符串
Dim StrdataP As String '写入参数后的应答字符串
Dim address As Single '下位机地址
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Const SND_ASYNC = &H1 '用异步方式播放声音,PlaySound函数在开始播放后立即返回
'****************************************************************
'窗体加载
'****************************************************************
Private Sub Form_Load()
Dim i As Integer
'初始化
For i = 0 To 19
Noise(i) = 0
Next i
For i = 0 To 19
LblName(i).Caption = i + 1
Next i
For i = 0 To 19
LblValue(i).Caption = "通讯中"
Next i
LblTimer.Caption = Date
LblTimer2.Caption = Time()
Flg = 1
FlgTime = 99
For i = 0 To 19
FlagNo(i) = 0
Next i
TempNum = Val(MDIForm1.CmbNum.Text)
TxtAddr.Text = 1
If Flg = 1 Then
Tim10.Enabled = True
FlgTime = Time '获取第一次取值的系统时间
FlgTimeMin = FlgTime
FlgTimeSeconds = FlgTime
Flg = 0
End If
rs1.Open "select top 1 * from TbValue1", cn, adOpenKeyset, adLockOptimistic
rs7.Open "select top 1 * from TbValue7", cn, adOpenKeyset, adLockOptimistic
rs30.Open "select top 1 * from TbValue30", cn, adOpenKeyset, adLockOptimistic
rsYear.Open "select top 1 * from TbValueYear", cn, adOpenKeyset, adLockOptimistic
'显示探测器个数
Dim j As Integer
For j = 0 To TempNum - 1
Pic(j).Visible = True
Lblitem(j).Visible = True
LblName(j).Visible = True
Next j
End Sub
''''''''*******************************************************************************
''''''''每10S存数
''''''''*******************************************************************************
Private Sub Tim10_Timer()
Dim n As Integer
For n = 0 To 19
If LblValue(n).Caption <> "通讯故障" And LblValue(0).Caption <> "通讯中" Then
value(n) = Val(Trim(LblValue(n).Caption))
Else
value(n) = 0
TxtState(n).Text = "通讯故障"
End If
Next n
For n = 0 To 19
If Pic(n).Visible = True Then
rs1.AddNew
rs1.Fields(1) = n + 1
rs1.Fields(2) = Date
rs1.Fields(3) = Time
rs1.Fields(4) = value(n)
rs1.Fields(5) = CStr(TxtState(n).Text)
rs1.MoveNext
End If
Next n
End Sub
'************************************************************
'发生报警,每1S存数
'************************************************************
Private Sub TimAlarm_Timer()
Dim n As Integer
For n = 0 To 19
If LblValue(n).Caption <> "通讯故障" And LblValue(0).Caption <> "通讯中" Then
value(n) = Val(Trim(LblValue(n).Caption))
Else
value(n) = 0
TxtState(n).Text = "通讯故障"
End If
Next n
For n = 0 To 19
If Pic(n).Visible = True Then
rs1.AddNew
rs1.Fields(1) = n + 1
rs1.Fields(2) = Date
rs1.Fields(3) = Time
rs1.Fields(4) = value(n)
rs1.Fields(5) = CStr(TxtState(n).Text)
rs1.MoveNext
End If
Next n
End Sub
'************************************************************
'实时更新数据库中的数据
'************************************************************
Private Sub Timer3_Timer()
'只保留当天和前一天的数据
connDest.Execute "delete * from tbvalue1 where DateDiff('d',Format(Valuedate,'YYYY/MM/DD'),Date()) <>0 and DateDiff('d',Format(Valuedate,'YYYY/MM/DD'),Date()) <>1"
'只保留7天之内的数据
connDest.Execute "delete * from tbvalue7 where DateDiff('d',Format(Valuedate,'YYYY/MM/DD'),Date()) >6 "
'只保留30天之内的数据
connDest.Execute "delete * from tbvalue30 where DateDiff('d',Format(Valuedate,'YYYY/MM/DD'),Date()) >29 "
rs1_1.Open "select top 1 * from TbValue1", cn1, adOpenKeyset, adLockOptimistic
rs1_2.Open "select top 1 * from TbValue1", cn2, adOpenKeyset, adLockOptimistic
rs1_3.Open "select top 1 * from TbValue1", cn3, adOpenKeyset, adLockOptimistic
rs7_1.Open "select top 1 * from TbValue7", cn1, adOpenKeyset, adLockOptimistic
rs7_2.Open "select top 1 * from TbValue7", cn2, adOpenKeyset, adLockOptimistic
rs7_3.Open "select top 1 * from TbValue7", cn3, adOpenKeyset, adLockOptimistic
rs30_1.Open "select top 1 * from TbValue30", cn1, adOpenKeyset, adLockOptimistic
rs30_2.Open "select top 1 * from TbValue30", cn2, adOpenKeyset, adLockOptimistic
rs30_3.Open "select top 1 * from TbValue30", cn3, adOpenKeyset, adLockOptimistic
rsYear_1.Open "select top 1 * from TbValueYear", cn1, adOpenKeyset, adLockOptimistic
rsYear_2.Open "select top 1 * from TbValueYear", cn2, adOpenKeyset, adLockOptimistic
rsYear_3.Open "select top 1 * from TbValueYear", cn3, adOpenKeyset, adLockOptimistic
''''''''*******************************************************************************
''''''''每10S存数
''''''''*******************************************************************************
Private Sub Tim10_Timer()
If LblValue(0).Caption <> "通讯故障" And LblValue(0).Caption <> "通讯中" Then
value1 = Val(Trim(LblValue(0).Caption))
Else
value1 = 0
TxtState(0).Text = "通讯故障"
End If
If LblValue(1).Caption <> "通讯故障" And LblValue(1).Caption <> "通讯中" Then
value2 = Val(Trim(LblValue(1).Caption))
Else
value2 = 0
TxtState(1).Text = "通讯故障"
End If
If LblValue(2).Caption <> "通讯故障" And LblValue(2).Caption <> "通讯中" Then
value3 = Val(Trim(LblValue(2).Caption))
Else
value3 = 0
TxtState(2).Text = "通讯故障"
End If
If LblValue(3).Caption <> "通讯故障" And LblValue(3).Caption <> "通讯中" Then
value4 = Val(Trim(LblValue(3).Caption))
Else
value4 = 0
TxtState(3).Text = "通讯故障"
End If
If Pic(0).Visible = True Then
rs1_1.AddNew
rs1_1.Fields(1) = Date
rs1_1.Fields(2) = Time
rs1_1.Fields(3) = value1
rs1_1.Fields(4) = CStr(TxtState(0).Text)
rs1_1.MoveNext
End If
If Pic(1).Visible = True Then
rs1_2.AddNew
rs1_2.Fields(1) = Date
rs1_2.Fields(2) = Time
rs1_2.Fields(3) = value2
rs1_2.Fields(4) = CStr(TxtState(1).Text)
rs1_2.MoveNext
End If
If Pic(2).Visible = True Then
rs1_3.AddNew
rs1_3.Fields(1) = Date
rs1_3.Fields(2) = Time
rs1_3.Fields(3) = value3
rs1_3.Fields(4) = CStr(TxtState(2).Text)
rs1_3.MoveNext
End If
If Pic(3).Visible = True Then
rs1_4.AddNew
rs1_4.Fields(1) = Date
rs1_4.Fields(2) = Time
rs1_4.Fields(3) = value4
rs1_4.Fields(4) = CStr(TxtState(3).Text)
rs1_4.MoveNext
End If
End Sub