用VB6.0编写客户端自动升级程序

　　曾经有位网友和我讨论怎样编写个通过服务器对客户机上进行自我升级问题由于我项目也涉及到自我升级当时我把我解决方案提了出来那就是做个类似于瑞星升级在这里我也发现了很多网友对这个问题很困惑故我愿意把我设计方案写出来和大家共享大家也可以通过这个思路用其他语言进行改写

　　以下是我具体思路:

　　写两个个是主；个是升级(升级放在服务器上)；

　　介绍说明:所有升级任务都由升级完成

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

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

　　3.删除旧主拷贝临时文件夹中文件到相应位置同时注册相应文件；

　　4.检查主状态若状态为活动则启动新主；

　　5.关闭升级

　　6.祝贺你升级完成

　　下面进行具体编写需建立 3个工程然后把它们编辑成个组 3个工程需共用个模块

　　建立工程步骤:

　　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 gMAX_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$(gMAX_SIZE)
　If GetPrivateProfileString(strSection, strKey, strKeyDefault, strBuffer, gMAX_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

　　 2、 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

　　 3、 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
Char = 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
　　' 摸拟从网站WebSite下载新更新
　　ChangeLabelPos Me, lblCap, "正在 摸拟从网站WebSite下载新升级 ..."
　　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



　　完成了 3个工程代码拷贝在代码必要的处我都进行了详细注释这里我就不再介绍代码了现在进行最后步模拟从网站WebSite下载升级后

　　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中相应处写下载代码即可

延伸阅读

• 2009-1-15-- vb6.0程序设计:用VB6.0设计简易赛车游戏
• 2009-1-15-- vb6.0程序设计:VB6.0应用程序界面设计探讨
• 2009-2-12-- vb6.0程序:浅谈用VB6.0编写BO程序
• 2009-1-15-- vb程序设计:VB程序设计1000问( 2)
• 2009-1-15-- vb6.0程序设计:基于VB6.0的MSComm通信思路方法设计
• 2009-2-12-- activexdll:VB6.0设计ActiveX DLL事
• 2009-1-15-- vb程序设计:VB多媒体程序设计
• 2008-9-25-- vb6.0程序:VB 6.0编制程序环境
• 2009-2-12-- vb6.0程序设计:VB6.0设计木马程序
• 2009-1-15-- vb6.0程序设计:利用VB6.0设计屏幕保护程序