1,217
社区成员
发帖
与我相关
我的任务
分享VB与ACCESS数据库交换数据，数据量很大，软件运行速度慢！
我用VB写的数据采集系统，将数据存入到ACCESS数据库中。
采集每台仪器的数据，每个仪器对应一个数据库，每个数据库中保存最近2天内每10秒产生的数据（17280个数据）、最近7天内每分钟的数据（10080个数据）、最近30天内每10分钟的数据（4320个数据），也就是说每个数据库中有17280+10080+4320=31680个数据，总共连接20台仪器，也就是有20个数据库。
软件运行起来，很慢！如何解决这个问题？请高手指点！！
采集每台仪器的数据，每个仪器对应一个数据库，每个数据库中保存最近2天内每10秒产生的数据（17280个数据）、最近7天内每分钟的数据（10080个数据）、最近30天内每10分钟的数据（4320个数据），也就是说每个数据库中有17280+10080+4320=31680个数据，总共连接20台仪器，也就是有20个数据库。
软件运行起来，很慢！如何解决这个问题？请高手指点！！
...全文
请发表友善的回复…
发表回复
happylxlyj 2012-10-10
- 打赏
- 举报
[Quote=引用 15 楼 的回复:]
那个do events 怎么用啊
请写个简单的模板，好么
[/Quote]
do while i=10
do events
i=i+1
loop
那个do events 怎么用啊
请写个简单的模板，好么
[/Quote]
do while i=10
do events
i=i+1
loop
zhuogirllz 2010-10-19
- 打赏
- 举报
那个do events 怎么用啊
请写个简单的模板，好么
请写个简单的模板，好么
zhuogirllz 2010-10-19
- 打赏
- 举报
[Quote=引用 13 楼 veron_04 的回复:]
大数据量处理为什么不先把数据存入内存中（比如定义一个大数组），等数据的量达到了一定时再写入数据库？你可定义一个结构类型，该类型中包含了所有你要存入数据库的信息，再定义一个该结构的数组，就拿10s存一次数据库的要求来说，一天也才24*3600/10＝8640个数据元素，以一个元素占用200个字节（其实未必达到200个字节）算，一天的数据占用内存：200*8640＝1.65MB，这个内存开销不大吧？且……
[/Quote]
用了你的方法，可是软件运行还是很慢。鼠标点击某个按钮，总是半天才能反应过来，这到底该怎么解决呢。
大数据量处理为什么不先把数据存入内存中（比如定义一个大数组），等数据的量达到了一定时再写入数据库？你可定义一个结构类型，该类型中包含了所有你要存入数据库的信息，再定义一个该结构的数组，就拿10s存一次数据库的要求来说，一天也才24*3600/10＝8640个数据元素，以一个元素占用200个字节（其实未必达到200个字节）算，一天的数据占用内存：200*8640＝1.65MB，这个内存开销不大吧？且……
[/Quote]
用了你的方法，可是软件运行还是很慢。鼠标点击某个按钮，总是半天才能反应过来，这到底该怎么解决呢。
zhuogirllz 2010-10-18
- 打赏
- 举报
Option Explicit
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函数在开始播放后立即返回
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函数在开始播放后立即返回
zx097x 2010-10-18
- 打赏
- 举报
怎么将数据存入到ACCESS数据库中的,把代码拿出来搂一眼,也许有可以优化的地方
贝隆 2010-10-18
- 打赏
- 举报
为何不可以天为单位对单个仪表创建数据表？这样一年也才365个表，而且我感觉你那些30天数据存一个数据没有必要。
孤独剑_LPZ 2010-10-18
- 打赏
- 举报
累计超过二百万条数据就考虑用mssql吧
饮水需思源 2010-10-18
- 打赏
- 举报
不管是ACCESS还是SQL，建800个表都可以
zhuogirllz 2010-10-18
- 打赏
- 举报
我的每个数据库中有4个表，如果这样建表的话，得80个数据库，这样做可以吗？
饮水需思源 2010-10-18
- 打赏
- 举报
用一个数据库，用一个表作为仪器档案，每个表中用仪器档案ID来区别各仪器的数据
如果数据量大，可以考虑用SQL数据库
如果数据量大，可以考虑用SQL数据库
贝隆 2010-10-18
- 打赏
- 举报
大数据量处理为什么不先把数据存入内存中（比如定义一个大数组），等数据的量达到了一定时再写入数据库？你可定义一个结构类型，该类型中包含了所有你要存入数据库的信息，再定义一个该结构的数组，就拿10s存一次数据库的要求来说，一天也才24*3600/10＝8640个数据元素，以一个元素占用200个字节（其实未必达到200个字节）算，一天的数据占用内存：200*8640＝1.65MB，这个内存开销不大吧？且在内存中存取数据很快，这对数据处理速度提升很有帮助。
问题的关键在于什么时候将数据存入数据库了，你可以在数组数据过半时存一次数据库，存数据库时后台处理，采用循环处理，循环中加入DoEvents，避免影响你的数据采集。此时系统会缓慢些。
问题的关键在于什么时候将数据存入数据库了，你可以在数组数据过半时存一次数据库，存数据库时后台处理，采用循环处理，循环中加入DoEvents，避免影响你的数据采集。此时系统会缓慢些。
zhuogirllz 2010-10-18
- 打赏
- 举报
修改了代码，把所有的数据存入一个数据库中，每10S的数据存入一个表中，每1分钟的数据存入一个表中，每10分钟的数据存入一个表中，每天的数据存入一个表中。请大家看下我的程序是否还可以优化？！！谢谢
zhuogirllz 2010-10-18
- 打赏
- 举报
'窗体加载
'****************************************************************
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
LblState0.BackColor = QBColor(12)
LblState1.BackColor = QBColor(14)
LblState2.BackColor = QBColor(15)
LblState3.BackColor = QBColor(7)
LblState4.BackColor = QBColor(10)
LblState0.Caption = "高报"
LblState1.Caption = "警告"
LblState2.Caption = "失效"
LblState3.Caption = "禁止"
LblState4.Caption = "正常"
'串口初始化，并打开串口
Me.MSComm1.CommPort = Trim(MDIForm1.CmbPort.Text)
Me.MSComm1.InputMode = comInputModeBinary
Me.MSComm1.RThreshold = 1
Me.MSComm1.PortOpen = True
Me.Timer1.Enabled = True
temp = 0
FlagParam = 0 '标记
'连接数据库，并打开数据表
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBData.mdb;Persist Security Info=False"
connDest.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBData.mdb;Persist Security Info=False"
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 "
End Sub
神马都能聊 2010-10-18
- 打赏
- 举报
Access的实时性是比较差的。。。
zhuogirllz 2010-10-18
- 打赏
- 举报
'连接数据库，并打开数据表
cn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBValue1.mdb;Persist Security Info=False"
cn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBValue2.mdb;Persist Security Info=False"
cn3.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBValue3.mdb;Persist Security Info=False"
connDest1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBValue1.mdb;Persist Security Info=False"
connDest2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBValue2.mdb;Persist Security Info=False"
connDest3.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBValue3.mdb;Persist Security Info=False"
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
cn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBValue1.mdb;Persist Security Info=False"
cn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBValue2.mdb;Persist Security Info=False"
cn3.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBValue3.mdb;Persist Security Info=False"
connDest1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBValue1.mdb;Persist Security Info=False"
connDest2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBValue2.mdb;Persist Security Info=False"
connDest3.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mdb\DBValue3.mdb;Persist Security Info=False"
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
zhuogirllz 2010-10-18
- 打赏
- 举报
''''''''*******************************************************************************
''''''''每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
''''''''每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
