用VB6.0编写自我升级的程序

    技术2022-05-11  80

    以下是我的具体思路: 

      写两个程序,一个是主程序;一个是升级程序(升级程序放在服务器上); 

      说明:所有升级任务都由升级程序完成。 

      1.启动升级程序,升级程序连接到网站,下载新的主程序(当然还包括支持的库文件等)到临时文件夹; 

      2.升级程序检测旧的主程序是否活动,若活动则关闭旧的主程序(同时记下主程序的状态); 

      3.删除旧的主程序,拷贝临时文件夹中的文件到相应的位置,同时注册相应的文件;  

      4.检查主程序的状态,若状态为活动的,则启动新的主程序; 

      5.关闭升级程序。  

      6.祝贺你,升级完成。  

      由于网友提出了关于升级这个升级程序的问题,以下是对其思路进行的一点补充,但原文仍然是升级主程序的,具体代码需读者自己添加:  

      7.主程序升级完毕;

      8.升级程序继续检查所下载的临时文件中是否含有NewUpdate.exe(新的升级程序)和rename.exe(是一个可以更改文件名的程序);

      9.若存在以上两个文件,表示要更新Update.exe文件;启动rename.exe程序,同时update.exe关掉自己;

      10.rename.exe程序检测update.exe是否已被关掉,若已关掉,删除该update.exe。移动临时文件夹中的NewUpdate.exe文件到主程序的目录下,同时更名为update.exe;

      11.rename.exe关掉自己。

      12.OK,至此升级程序也被升级了。 

      下面进行具体的程序编写,需建立三个工程,然后把它们编辑成一个组,三个工程需共用一个模块。  

      建立工程步骤:  

      1. 建立工程proMain:打开vb,“新建工程”,选择“标准EXE”, 再给工程中添加模块,并且命名为modCommon,修改窗体名为frmMain,同时修改工程名为projMain,然后保存到某个文件夹(譬如在桌面建立个文件夹Update),窗体、模块和工程分别保存为frmMain.frm、modCommon.bas、projMain.vbp; 

      2. 建立工程projNewMain:点击菜单“文件 新建工程” ,选择“标准EXE”,点击菜单“工程 添加模块”,在弹出的对话框中选择“现存”标签,定位到Update文件夹,选中modCommon.bas模块。修改窗体名为frmNewMain,同时修改工程名为projNewMain,然后保存到Update文件夹,窗体和工程分别保存为frmNewMain.frm、projNewMain.vbp; 

      3.建立工程projUpdate:点击菜单“文件 新建工程” ,选择“标准EXE”,点击菜单“工程 添加模块”,在弹出的对话框中选择“现存”标签,定位到Update文件夹,选中modCommon.bas模块。修改窗体名为frmUpdate,同时修改工程名为projUpdate,然后保存到Update文件夹,窗体和工程分别保存为frmUpdate.frm、projUpdate.vbp; 

      4.建立组:在工程projUpdate中,点击菜单“文件 添加工程…”在弹出的对话框中选择“现存”标签,定位到Update文件夹,选择projMain.vbp;重复该动作,选择projNewMain.vbp;保存该组即可;  

      5.关闭工程,定位到Update文件夹,然后执行下面的步骤。 

      各个工程文件中的文件源码: 

      一、 projMain.vbp工程: 

      说明:这个是旧的主程序,从来没有进行过升级前的程序。 

      用记事本打开frmMain.frm文件,copy以下内容到其中: 

      VERSION 5.00      Begin VB.Form frmMain        Caption = "请点击升级进行程序"    ClientHeight = 1140     ClientLeft = 60     ClientTop = 345     ClientWidth = 4500       LinkTopic = "Form1"     ScaleHeight = 1140    ScaleWidth = 4500    StartUpPosition = 3 ''窗口缺省     Begin VB.CommandButton Command1      Caption = "升级"    Height = 525     Left = 1380     TabIndex = 0     Top = 570     Width = 1245    End     End     Attribute VB_Name = "frmMain"     Attribute VB_GlobalNameSpace = False     Attribute VB_Creatable = False     Attribute VB_PredeclaredId = True     Attribute VB_Exposed = False     Option Explicit      '' 升级程序的例子       '' 作者: 谢家峰      '' 日期: 2003/12/19     '' 这里是没有升级时的主程序     Private Sub Command1_Click()    Command1.Enabled = False     '' 运行更新程序    Shell App.Path & "/update.exe", vbNormalFocus     End Sub    Private Sub Form_Load()    If App.PrevInstance Then End     UpdateIniPath = App.Path & "/Update.ini"    '' 记录主程序的名字    WritePrivateProfileString "Main", "Name", App.EXEName, UpdateIniPath    '' 记录运行状态    WritePrivateProfileString "Main", "Active", "-1", UpdateIniPath    '' 记录更新次数    WritePrivateProfileString "Update", "Num", "0", UpdateIniPath     Me.Caption = App.EXEName    End Sub     Private Sub Form_Unload(Cancel As Integer)      '' 记录运行状态     WritePrivateProfileString "Main", "Active", "0", UpdateIniPath    End Sub   用记事本打开modCommon.bas文件,copy以下内容到其中:    Attribute VB_Name = "modCommon"      Option Explicit    '' 升级程序的例子     '' 作者: 谢家峰    '' 日期: 2003/12/19      '' 这里是通用模块,放置API函数以及公用函数    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)    Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal lSize As Long, ByVal lpFilename As String) As Long     Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As Any, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFilename As String) As Long     Public Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFilename As String) As Long     Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long      Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long    Const WM_Close = &H10    Private Const gintMAX_SIZE% = 255 ''Maximum buffer size    Public UpdateIniPath As String      '' 从资源文件中提取文件     Public Function SaveFileFromRes(vntResourceID As Variant, sType As String, sFileName As String) As Boolean      Dim bytImage() As Byte    Dim iFileNum As Integer      On Error GoTo SaveFileFromRes_Err      SaveFileFromRes = True    bytImage = LoadResData(vntResourceID, sType)    iFileNum = FreeFile     Open sFileName For Binary As iFileNum    Put #iFileNum, , bytImage    Close iFileNum    Exit Function     SaveFileFromRes_Err:     SaveFileFromRes = False: Exit Function     End Function      '' 从缓冲区中读取字符串      Private Function StringFromBuffer(Buffer As String) As String     Dim nPos As Long     nPos = InStr(Buffer, vbNullChar)    If nPos > 0 Then     StringFromBuffer = Left$(Buffer, nPos - 1)     Else     StringFromBuffer = Buffer     End If      End Function     '' 读Ini文件     Public Function ReadIniFile(ByVal strIniFile As String, ByVal strSection As String, ByVal strKey As String, Optional ByVal strKeyDefault As String = vbNullString) As String    Dim strBuffer As String     strBuffer = Space$(gintMAX_SIZE)     If GetPrivateProfileString(strSection, strKey, strKeyDefault, strBuffer, gintMAX_SIZE, strIniFile) Then       ReadIniFile = StringFromBuffer(strBuffer)    End If       End Function     '' 检查文件是否存在     Function FileExists(filename As String) As Boolean     On Error Resume Next    FileExists = (Dir$(filename) <> "")     End Function    '' 改变标签的文本及位置     Public Function ChangeLabelPos(frm As Form, lbl As Label, msg As String)     With lbl     .Caption = msg     .Left = (frm.ScaleWidth - .Width) / 2     .Top = .Height / 2     End With      End Function      ''关闭窗体    Function CloseValidForm(Ret As String) As Boolean    Dim WinWnd As Long     ''搜寻该窗口的句柄       WinWnd = FindWindow(vbNullString, Ret)    If WinWnd <> 0 Then     SendMessage WinWnd, WM_Close, 0&, 0&     End If    CloseValidForm = True    End Function  二、 projNewMain.vbp工程:

      说明:这个是新的主程序,即升级后的主程序,由于我目前没有服务器,故将该程序放在projUpdate.vbp工程的资源文件中。在projUpdate.vbp中模拟网络升级。  

      用记事本打开frmNewMain.frm文件,copy以下内容到其中:    VERSION 5.00    Begin VB.Form frmNewMain    Appearance = 0 ''Flat    BackColor = &H80000005&    Caption = "Form1"    ClientHeight = 1365    ClientLeft = 60    ClientTop = 345    ClientWidth = 4680    LinkTopic = "Form1"   ScaleHeight = 1365    ScaleWidth = 4680    StartUpPosition = 3 ''窗口缺省    Begin VB.CommandButton Command1    Caption = "升级"    Height = 525    Left = 1410    TabIndex = 0    Top = 660    Width = 1245    End    Begin VB.Label lblCap    Caption = "告诉你,我已经升级了,没看出和以前不一样了吗?"    Height = 255    Left = 120    TabIndex = 1    Top = 60    Width = 4275    End    End    Attribute VB_Name = "frmNewMain"    Attribute VB_GlobalNameSpace = False    Attribute VB_Creatable = False    Attribute VB_PredeclaredId = True    Attribute VB_Exposed = False    Option Explicit    '' 升级程序的例子    '' 作者: 谢家峰    '' 日期: 2003/12/19    '' 这里是升级后的主程序    Private Sub Command1_Click()    Command1.Enabled = False    '' 运行更新程序    Shell App.Path & "/update.exe", vbNormalFocus    End Sub    Private Sub Form_Load()    Dim i As Integer    If App.PrevInstance Then End    UpdateIniPath = App.Path & "/Update.ini"    '' 记录主程序的名字    WritePrivateProfileString "Main", "Name", App.EXEName, UpdateIniPath    '' 记录运行状态    WritePrivateProfileString "Main", "Active", "-1", UpdateIniPath    Me.Caption = App.EXEName    End Sub    Private Sub Form_Unload(Cancel As Integer)    '' 记录运行状态    WritePrivateProfileString "Main", "Active", "0", UpdateIniPath    End Sub

      三、 projUpdate.vbp工程:

      说明:这是升级程序,含有一个资源文件。

      用记事本打开frmUpdate.frm文件,copy以下内容到其中:

      VERSION 5.00    Begin VB.Form frmUpdate    BackColor = &H80000007&    BorderStyle = 0 ''None    Caption = "Form1"    ClientHeight = 1185    ClientLeft = 0    ClientTop = 0    ClientWidth = 5400    LinkTopic = "Form1"    MaxButton = 0 ''False    MinButton = 0 ''False    ScaleHeight = 1185    ScaleWidth = 5400    ShowInTaskbar = 0 ''False    StartUpPosition = 2 ''屏幕中心    Begin VB.CommandButton Command1    Appearance = 0 ''Flat    Caption = "关闭"    Height = 435    Left = 2130    TabIndex = 0    Top = 630    Visible = 0 ''False    Width = 1245    End    Begin VB.Label lblCap    AutoSize = -1 ''True    BackStyle = 0 ''Transparent    BeginProperty Font    Name = "宋体"    Size = 12    Charset = 134    Weight = 400    Underline = 0 ''False    Italic = 0 ''False    Strikethrough = 0 ''False    EndProperty    ForeColor = &H000000FF&    Height = 240    Left = 330    TabIndex = 1    Top = 150    Width = 120     End    Begin VB.Shape Shape1    BackColor = &H00C0FFFF&    BackStyle = 1 ''Opaque    BorderColor = &H0000FF00&    Height = 1065    Left = 60    Top = 60    Width = 5265    End    End    Attribute VB_Name = "frmUpdate"    Attribute VB_GlobalNameSpace = False    Attribute VB_Creatable = False    Attribute VB_PredeclaredId = True   Attribute VB_Exposed = False    Option Explicit    '' 升级程序的例子    '' 作者: 谢家峰    '' 日期: 2003/12/19    '' 这里是升级程序    Dim State As Boolean    Private Sub Command1_Click()    Unload Me    End Sub

    Private Sub Form_Activate()    Dim i As Integer    Dim j As String    Dim OldExeFile As String    Dim NewExeFile As String    Dim tmpFile As String    Dim MainState As Boolean    DoEvents    If State Then    '' 获取旧主程序名称    OldExeFile = CStr(ReadIniFile(UpdateIniPath, "Main", "Name", "主程序"))    NewExeFile = OldExeFile    OldExeFile = App.Path & "/" & OldExeFile & ".exe"    tmpFile = App.Path & "/tmp.tmp"    '' 改写升级次数    i = CInt(ReadIniFile(UpdateIniPath, "Update", "Num", "0"))    i = i + 1   ChangeLabelPos Me, lblCap, "这是您第" & i & "次升级!"    Sleep 1500    '' 摸拟从网站下载新的更新程序。    ChangeLabelPos Me, lblCap, "正在 摸拟从网站下载新的升级程序 ..."    Sleep 1000    On Error Resume Next    Kill tmpFile    '' 此处可以修改为将临时文件放在临时文件夹内    SaveFileFromRes 101, "CUSTOM", tmpFile Sleep 1000    On Error GoTo 0    '' 检查主程序是否开启,若开启则关闭旧程序    MainState = CBool(CInt(ReadIniFile(UpdateIniPath, "Main", "Active", "0")))    If MainState Then    '' 关闭旧程序    ChangeLabelPos Me, lblCap, "正在关闭旧程序 ... "    Sleep 300    '' 这里强行关闭旧程序    '' 你也可以发送消息,让旧程序自己关闭    Do While -1    DoEvents    If CloseValidForm(NewExeFile) Then    Exit Do    End If    Loop    Sleep 200    End If    '' 删除旧程序    On Error Resume Next    ChangeLabelPos Me, lblCap, "正在删除旧程序 ... "    Sleep 1000    Kill OldExeFile    Sleep 1000      '' 生成新主程序名称    ''NewExeFile = CStr(ReadIniFile(UpdateIniPath, "Main", "Name", "主程序"))    j = Right(NewExeFile, 1)    If IsNumeric(j) Then    j = i    NewExeFile = Left(NewExeFile, Len(NewExeFile) - 1)    Else    j = 1    End If    '' 记录主程序的名字    NewExeFile = NewExeFile & j    WritePrivateProfileString "Main", "Name", NewExeFile, UpdateIniPath    NewExeFile = App.Path & "/" & NewExeFile & ".exe"      '' 拷贝新程序    ChangeLabelPos Me, lblCap, "正在更新程序 ... "    Sleep 1000    FileCopy tmpFile, NewExeFile    Sleep 1000    '' 删除临时程序    Kill tmpFile    '' 记录更新次数   WritePrivateProfileString "Update", "Num", CStr(i), UpdateIniPath    '' 检查旧程序的状态    If MainState Then    ChangeLabelPos Me, lblCap, "正在启动更新后的主程序 ... "   Sleep 1000    Shell NewExeFile, vbNormalNoFocus    End If    '' 关闭更新程序    Command1.Visible = True    ChangeLabelPos Me, lblCap, "更新完成,请等待 3 秒后将自动关闭更新程序 ..."    Sleep 3000    lblCap.Refresh    Unload Me    End If    End Sub    Private Sub Form_Load()    If App.PrevInstance Then End    UpdateIniPath = App.Path & "/Update.ini"    State = True    End Sub    完成了三个工程的代码拷贝,在代码的必要之处我都进行了详细注释,这里我就不再介绍代码了,现在进行最后一步,模拟从网站下载升级后的程序。    a.打开projMain.vbp,编译该工程,并且命名为“主程序.exe”;    b.打开projNewMain.vbp,编译该工程,并且命名为“projNewMain.exe”;  c. 打开projUpdate.vbp,打开工具栏上的“vb资源编辑器”(若没找到,读者需要点击菜单“外接程序 外接程序管理器”,在打开的对话框中选择“vb6资源编辑器”,在加载行为中选择“加载/卸载”复选框),在资源编辑器中选择“添加自定义资源 …”,在打开的对话框中定位到Update文件夹,选择projNewMain.exe文件,保存该资源文件,最后编译该工程并且命名为“Update.exe”。

      d.将可执行文件“主程序.exe”、“Update.exe”拷贝到同一个文件夹中,运行任一个程序,相信读者会看到效果。

      以上代码比较简单,仅供读者分析思路用。在实际工程中的代码编写时也根本没必要把projNewMain.exe放在资源文件中,读者只需将它放在服务器的某个位置,然后在projUpdate.vbp中的相应处写下载代码即可。

      Ok,文章至此编写完成,希望对各位读者能有所帮助。


    最新回复(0)