我的新版本文件写在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

解决方案 »

  1.   

    从新版本执行程序的修改时间及特地设定的区别设置来看,编译运行的时候新版本是肯定下载下来了,生成EXE文件以后也能下载下来,只是一定要运行到内存溢出才能更新.
    代码确实比较长,哪位大哥耐心帮我一下,不知道我能不能加分,好象是要过24小时才可以加的,这些代码我自己查了很久就是查不出错在哪里,请帮帮我吧,谢谢了!