我的新版本文件写在image字段中,另有版本号、文件名字段。本是想根据版本号的变化来自动更新,编译运行的时候一切正常,生成exe文件后执行就进入死循环,不停的跳对话框或者不停的执行辅助程序的FORM,一直到内存溢出才停!这个是我主程序启动界面中写的时间触发代码,1000毫秒。
Private Sub Timer1_Timer()
Timer1.Enabled = False
If getifbbgs Then
MsgBox "程序有最新版本,系统将自动升级!", vbOKOnly + vbExclamation, "系统消息!" Shell App.Path() & "\qdwj.exe", vbNormalFocus 'qdwj.exe是辅助程序的执行文件 Unload Me End IfEnd Sub这里是辅助程序中的主要代码,时间触发事件1000毫秒。
Private Sub Form_Load()
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set mstream = New ADODB.Stream
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
'获取文件当前路径
mypath = App.Path
MsgBox "asdasdads"
If Right(mypath, 1) = "\" Then
Else
mypath = mypath & "\"
End If
'判断文件版本是否过时
str = connectstring
conn.Open str
rs.Open "select max(bbh) as bbh from zxbbwj ", conn, adOpenKeyset, adLockOptimistic
m_zdbbh = rs.Fields("bbh").Value & ""
myfile = mypath & "bt999.ini"
If fs.FileExists(myfile) Then
l = GetFromINI("operating systems", "zdbbh", mypath & "bt999.ini")
''MsgBox b
If Trim(m_zdbbh) = Trim(l) Then
'未过时
rs.Close Unload Formwjxz
Exit Sub
End If
End If
rs.Close
'获取最新版本文件名列表
rs.Open "Select wjm from zxbbwj group by wjm ", conn, adOpenKeyset, adLockOptimistic
If rs.EOF And rs.BOF Then
Exit Sub
End If
i = 0
Do While Not rs.EOF
i = i + 1
wjmb(i) = rs.Fields("wjm").Value
rs.MoveNext
Loop
rs.Close
'循环判断下载最新版本文件
mstream.Type = adTypeBinary
mstream.Open
Do While i > 0
If rs.State = 1 Then rs.Close
rs.Open "Select * from zxbbwj where bbh=(select max(bbh) from zxbbwj where wjm='" & wjmb(i) & "')", conn, adOpenKeyset, adLockOptimistic
m_bbh = rs.Fields("bbh").Value
myfile = mypath & "bt999.ini"
If fs.FileExists(myfile) Then
'bt999.ini文件存在
wj = wjmb(i)
l = GetFromINI("operating systems", wjmb(i), mypath & "bt999.ini") If m_bbh = Val(l) Then
'未过时 Else ''MsgBox "您的软件版本已过时,正在下载最新版本!"
'判断文件存在否,在则删除
myfile = mypath & wjmb(i)
If fs.FileExists(myfile) Then
Kill myfile
Else
End If
'从数据库下载最新文件
mstream.Write rs.Fields("wjnr").Value
mstream.SaveToFile myfile
str = rs.Fields("bbh").Value
l = modiini(str, "operating systems", wjmb(i), mypath & "bt999.ini")
End If
Else
'bt999.ini文件存在
''MsgBox "您的软件版本已过时,正在下载最新版本!"
'判断目标文件存在否,在则删除
myfile = mypath & wjmb(i)
If fs.FileExists(myfile) Then
Kill myfile
Else
End If
'从数据库下载最新文件
mstream.Write rs.Fields("wjnr").Value
mstream.SaveToFile myfile
str = rs.Fields("bbh").Value
l = modiini(str, "operating systems", wjmb(i), mypath & "bt999.ini")
End If
i = i - 1
Loop
l = modiini(m_zdbbh, "operating systems", "zdbbh", mypath & "bt999.ini")
rs.Close
MsgBox "本程序已经升级到最新版本,请重新登录!", vbOKOnly + vbExclamation
Unload Me Shell App.Path() & "\ksxt.exe", vbNormalFocus
End Sub这里是用到的几个函数
Public Function connectstring() As String
connectstring = "Provider=SQLOLEDB.1;Password=sa;Persist Security Info=True;User ID=sa;Initial Catalog=ks;Data Source=VIP-098F274CD76"
End FunctionPublic Function GetFromINI(AppName As String, KeyName As String, filename As String) As String
Dim RetStr As String
RetStr = String(255, Chr(0))
GetFromINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", RetStr, Len(RetStr), filename))
End FunctionPublic Function modiini(NewString As String, AppName As String, KeyName As String, filename As String) As Boolean
Dim BB As Boolean
modiini = WritePrivateProfileString(AppName, ByVal KeyName, NewString, filename)
End FunctionPublic Function getifbbgs() As Boolean '判断版本是否过时
Dim rs As New ADODB.Recordset
Dim str As String
Dim mypath As String
Dim myfile As String
Dim m_bbh As Double
Dim fs As New FileSystemObject
Dim m_zdbbh As String
Dim l As Double
'判断文件版本是否过时
If cn.State <> 1 Then
cn.CursorLocation = adUseClient
cn.Open connectstring
End If
'获取文件当前路径
mypath = App.Path
If Right$(mypath, 1) = "\" Then
Else
mypath = mypath & "\"
End If
rs.Open "select max(bbh) as bbh from zxbbwj ", cn, adOpenKeyset, adLockOptimistic
m_zdbbh = rs.Fields("bbh").Value & ""
myfile = mypath & "bt999.ini"
If fs.FileExists(myfile) Then
l = GetFromINI("operating systems", "zdbbh", mypath & "bt999.ini")
If Trim(m_zdbbh) = Trim(l) Then
'未过时
getifbbgs = False
rs.Close
Exit Function
End If
End If
rs.Close
'已过时
getifbbgs = True
End Function
Private Sub Timer1_Timer()
Timer1.Enabled = False
If getifbbgs Then
MsgBox "程序有最新版本,系统将自动升级!", vbOKOnly + vbExclamation, "系统消息!" Shell App.Path() & "\qdwj.exe", vbNormalFocus 'qdwj.exe是辅助程序的执行文件 Unload Me End IfEnd Sub这里是辅助程序中的主要代码,时间触发事件1000毫秒。
Private Sub Form_Load()
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set mstream = New ADODB.Stream
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
'获取文件当前路径
mypath = App.Path
MsgBox "asdasdads"
If Right(mypath, 1) = "\" Then
Else
mypath = mypath & "\"
End If
'判断文件版本是否过时
str = connectstring
conn.Open str
rs.Open "select max(bbh) as bbh from zxbbwj ", conn, adOpenKeyset, adLockOptimistic
m_zdbbh = rs.Fields("bbh").Value & ""
myfile = mypath & "bt999.ini"
If fs.FileExists(myfile) Then
l = GetFromINI("operating systems", "zdbbh", mypath & "bt999.ini")
''MsgBox b
If Trim(m_zdbbh) = Trim(l) Then
'未过时
rs.Close Unload Formwjxz
Exit Sub
End If
End If
rs.Close
'获取最新版本文件名列表
rs.Open "Select wjm from zxbbwj group by wjm ", conn, adOpenKeyset, adLockOptimistic
If rs.EOF And rs.BOF Then
Exit Sub
End If
i = 0
Do While Not rs.EOF
i = i + 1
wjmb(i) = rs.Fields("wjm").Value
rs.MoveNext
Loop
rs.Close
'循环判断下载最新版本文件
mstream.Type = adTypeBinary
mstream.Open
Do While i > 0
If rs.State = 1 Then rs.Close
rs.Open "Select * from zxbbwj where bbh=(select max(bbh) from zxbbwj where wjm='" & wjmb(i) & "')", conn, adOpenKeyset, adLockOptimistic
m_bbh = rs.Fields("bbh").Value
myfile = mypath & "bt999.ini"
If fs.FileExists(myfile) Then
'bt999.ini文件存在
wj = wjmb(i)
l = GetFromINI("operating systems", wjmb(i), mypath & "bt999.ini") If m_bbh = Val(l) Then
'未过时 Else ''MsgBox "您的软件版本已过时,正在下载最新版本!"
'判断文件存在否,在则删除
myfile = mypath & wjmb(i)
If fs.FileExists(myfile) Then
Kill myfile
Else
End If
'从数据库下载最新文件
mstream.Write rs.Fields("wjnr").Value
mstream.SaveToFile myfile
str = rs.Fields("bbh").Value
l = modiini(str, "operating systems", wjmb(i), mypath & "bt999.ini")
End If
Else
'bt999.ini文件存在
''MsgBox "您的软件版本已过时,正在下载最新版本!"
'判断目标文件存在否,在则删除
myfile = mypath & wjmb(i)
If fs.FileExists(myfile) Then
Kill myfile
Else
End If
'从数据库下载最新文件
mstream.Write rs.Fields("wjnr").Value
mstream.SaveToFile myfile
str = rs.Fields("bbh").Value
l = modiini(str, "operating systems", wjmb(i), mypath & "bt999.ini")
End If
i = i - 1
Loop
l = modiini(m_zdbbh, "operating systems", "zdbbh", mypath & "bt999.ini")
rs.Close
MsgBox "本程序已经升级到最新版本,请重新登录!", vbOKOnly + vbExclamation
Unload Me Shell App.Path() & "\ksxt.exe", vbNormalFocus
End Sub这里是用到的几个函数
Public Function connectstring() As String
connectstring = "Provider=SQLOLEDB.1;Password=sa;Persist Security Info=True;User ID=sa;Initial Catalog=ks;Data Source=VIP-098F274CD76"
End FunctionPublic Function GetFromINI(AppName As String, KeyName As String, filename As String) As String
Dim RetStr As String
RetStr = String(255, Chr(0))
GetFromINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", RetStr, Len(RetStr), filename))
End FunctionPublic Function modiini(NewString As String, AppName As String, KeyName As String, filename As String) As Boolean
Dim BB As Boolean
modiini = WritePrivateProfileString(AppName, ByVal KeyName, NewString, filename)
End FunctionPublic Function getifbbgs() As Boolean '判断版本是否过时
Dim rs As New ADODB.Recordset
Dim str As String
Dim mypath As String
Dim myfile As String
Dim m_bbh As Double
Dim fs As New FileSystemObject
Dim m_zdbbh As String
Dim l As Double
'判断文件版本是否过时
If cn.State <> 1 Then
cn.CursorLocation = adUseClient
cn.Open connectstring
End If
'获取文件当前路径
mypath = App.Path
If Right$(mypath, 1) = "\" Then
Else
mypath = mypath & "\"
End If
rs.Open "select max(bbh) as bbh from zxbbwj ", cn, adOpenKeyset, adLockOptimistic
m_zdbbh = rs.Fields("bbh").Value & ""
myfile = mypath & "bt999.ini"
If fs.FileExists(myfile) Then
l = GetFromINI("operating systems", "zdbbh", mypath & "bt999.ini")
If Trim(m_zdbbh) = Trim(l) Then
'未过时
getifbbgs = False
rs.Close
Exit Function
End If
End If
rs.Close
'已过时
getifbbgs = True
End Function
代码确实比较长,哪位大哥耐心帮我一下,不知道我能不能加分,好象是要过24小时才可以加的,这些代码我自己查了很久就是查不出错在哪里,请帮帮我吧,谢谢了!