VB程序运行一段时间报错
程序自从加了这段代码之后出现问题,报虚拟内存增大太小,且运行一段时间后自动关闭或者弹出错误
初步怀疑是在这个模块里头,各位高手查看下，看错误出在哪里,是否有语句错误。
'功能:对数据库里的白名单进行对比, 并且纠正
code:
[code=VB][/code]
'白名单纠错功能
'当白名单模式开启进行白名单查询纠错---->
If sys.WhiteList = True Then
Debug.Print "进行白名单纠错"
LabelPlateText(X).Caption = jiucuo3(LabelPlateText(X).Caption)
End If
If tempCP <> LabelPlateText(X).Caption Then
Debug.Print "车牌" & tempCP & "纠正为" & LabelPlateText(X).Caption
WriteTXT "车牌" & tempCP & "纠正为" & LabelPlateText(X).Caption, Hour(Time)
jiucuoPD = True
Else
BypassTime = Now
jiucuoPD = False
End If
'<----进行白名单查询纠错
'进行区号识别过滤----->
If sys.section And jiucuoPD = False Then
Debug.Print "进行区号过滤"
If section(LabelPlateText(X).Caption) = False Then
Debug.Print "车牌错误--过滤成功"
GoTo err:
End If
BypassTime = Now
End If
Function jiucuo3(str As String) As String
Dim cp As String
Dim i As Integer
Dim Z As Integer
Dim X As Integer
Dim cp1 As String
Dim cp2 As String
Dim cp3 As String
Dim mohucp As String
Dim mohucp2 As String
Dim zz As Integer
cp = right(str, 5)
If ListSelect(str, 1) = "" Then '查询白名单
For i = 0 To 5 - 1 '取4字符相似车牌
zz = zz + 1
cp1 = left(cp, i)
Z = i
cp2 = Mid(cp, Z + 1, 1)
cp3 = right(cp, 5 - Z - 1)
mohucp = cp1 & "*" & cp3
If ListSelect(mohucp, 2) = "" Then '查询白名单
If sys.WhiteListNo = 2 Then
For X = 0 To 5 - 1 '取3字符相似车牌
Z = X
If Mid(mohucp, Z + 1, 1) <> "*" Then
cp1 = left(mohucp, Z)
Z = X
cp2 = Mid(mohucp, Z + 1, 1)
cp3 = right(mohucp, 5 - Z - 1)
mohucp2 = Trim(" " & cp1 & "*" & cp3)
If ListSelect(mohucp2, 2) = "" Then '查询白名单
Else
jiucuo3 = mohucp2
Exit Function
End If
End If
zz = zz + 1
Next X
End If
Else
jiucuo3 = mohucp
Exit Function
End If
Next i
Else
jiucuo3 = str
Exit Function
End If
jiucuo3 = str
End Function
'白名单查询
Function ListSelect(cphm As String, Index As Integer) As String
Dim rs As New ADODB.Recordset
rs.CursorLocation = adUseClient
Dim X() As String
If rs.State <> 0 Then rs.Close
Select Case Index
Case 1
Dim temp As String
X = Split(cphm, "-")
For i = 0 To UBound(X)
temp = temp & X(i)
Next
rs.Open "select * from 白名单 where cphm ='" & temp & "'", cn
If rs.RecordCount > 0 Then
ListSelect = Trim(rs.Fields("cphm"))
cphm = left(ListSelect, 2) & "-" & right(ListSelect, 5)
Else
ListSelect = ""
End If
Case 2
X = Split(cphm, "*")
Select Case UBound(X)
Case 1
rs.Open "select cphm ,id from 白名单 where cphm like '%" & X(0) & "%" & X(1) & "%'", cn
Case 2
rs.Open "select cphm from 白名单 where RIGHT(cphm,6) like '%" & X(0) & "_" & X(1) & "_" & X(2) & "_'", cn
Case 3
End Select
If rs.RecordCount > 0 Then
Debug.Print "找到白名单,进行纠错"
ListSelect = Trim(rs.Fields("cphm"))
X = Split(ListSelect, "-")
For i = 0 To UBound(X)
temp = temp & X(i)
Next
ListSelect = temp
cphm = left(ListSelect, 2) & "-" & right(ListSelect, 5)
Else
ListSelect = ""
End If
End Select
Set rs = Nothing
End Function
'区号白名单查询
'str 车牌号码
'有此区号白名单返回 true
'无此区号白名单记录返回 false
Function section(str As String) As Boolean
Dim rs As New ADODB.Recordset
rs.CursorLocation = adUseClient
Dim qh As String
qh = left(str, 2)
If rs.State <> 0 Then rs.Close
rs.Open "select 区号 from 区号白名单 where 区号 ='" & qh & "'", cn
If rs.RecordCount > 0 Then
section = True
Else
section = False
End If
Set rs = Nothing
End Function
[解决办法]
应该是recordset有泄漏。
记得调用set rs = nothing 以前一定要close
[解决办法]
[解决办法]
[解决办法]
[解决办法]
[解决办法]
跟系统休眠和待机都可能有关
先关闭休眠
待机中除关闭显示器，其它都选择从不。
重新测试你的程序，如果还有这问题再检测程序问题。