曾經有位網友和我討論怎樣編寫一個通過服務器對客戶機上的程序進行自我升級的問題，由于我的項目也涉及到自我升級，當時我把我的解決方案提了出來，那就是做一個類似于瑞星的升級程序。在這里我也發現了很多的網友對這個問題很困惑，故我愿意把我的設計方案寫出來與大家共享，大家也可以通過這個思路用其他語言進行改寫。
以下是我的具體思路：
寫兩個程序，一個是主程序；一個是升級程序（升級程序放在服務器上）；
說明：所有升級任務都由升級程序完成。
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
´ ------------------------------------------
´ 升級程序的例子
´ 作者: 謝家峰
´ 日期:
´
´ 這里是沒有升級時的主程序
´
´ ------------------------------------------
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 "
´ 記錄更新次數
WritePrivateProfileString "Update", "Num", "0", UpdateIniPath
Me.Caption = App.EXEName
End Sub
Private Sub Form_Unload(Cancel As Integer)
´ 記錄運行狀態
WritePrivateProfileString "
End Sub
用記事本打開modCommon.bas文件，copy以下內容到其中：
Attribute VB_Name = "modCommon"
Option Explicit
´ ------------------------------------------
´ 升級程序的例子
´ 作者: 謝家峰
´ 日期:
´
´ 這里是通用模塊，放置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
文章來源于領測軟件測試網 http://www.kjueaiud.com/
