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

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