用VB6.0編寫自我升級的程序(一)

曾經(jīng)有位網(wǎng)友和我討論怎樣編寫一個通過服務(wù)器對客戶機(jī)上的程序進(jìn)行自我升級的問題，由于我的項目也涉及到自我升級，當(dāng)時我把我的解決方案提了出來，那就是做一個類似于瑞星的升級程序。在這里我也發(fā)現(xiàn)了很多的網(wǎng)友對這個問題很困惑，故我愿意把我的設(shè)計方案寫出來與大家共享，大家也可以通過這個思路用其他語言進(jìn)行改寫。

以下是我的具體思路：

寫兩個程序，一個是主程序；一個是升級程序（升級程序放在服務(wù)器上）；

說明：所有升級任務(wù)都由升級程序完成。

1.啟動升級程序，升級程序連接到網(wǎng)站，下載新的主程序（當(dāng)然還包括支持的庫文件等）到臨時文件夾；

2.升級程序檢測舊的主程序是否活動，若活動則關(guān)閉舊的主程序（同時記下主程序的狀態(tài)）；

3.刪除舊的主程序，拷貝臨時文件夾中的文件到相應(yīng)的位置，同時注冊相應(yīng)的文件；

4.檢查主程序的狀態(tài)，若狀態(tài)為活動的，則啟動新的主程序；

5.關(guān)閉升級程序。

6.祝賀你，升級完成。

由于網(wǎng)友提出了關(guān)于升級這個升級程序的問題，以下是對其思路進(jìn)行的一點補(bǔ)充，但原文仍然是升級主程序的，具體代碼需讀者自己添加：

7.主程序升級完畢；
8.升級程序繼續(xù)檢查所下載的臨時文件中是否含有NewUpdate.exe（新的升級程序）和rename.exe（是一個可以更改文件名的程序)；
9.若存在以上兩個文件，表示要更新Update.exe文件；啟動rename.exe程序，同時update.exe關(guān)掉自己；
10.rename.exe程序檢測update.exe是否已被關(guān)掉，若已關(guān)掉，刪除該update.exe。移動臨時文件夾中的NewUpdate.exe文件到主程序的目錄下，同時更名為update.exe;
11.rename.exe關(guān)掉自己。
12.OK,至此升級程序也被升級了。

下面進(jìn)行具體的程序編寫，需建立三個工程，然后把它們編輯成一個組，三個工程需共用一個模塊。

建立工程步驟：

1.        建立工程proMain：打開vb,“新建工程”，選擇“標(biāo)準(zhǔn)EXE”, 再給工程中添加模塊，并且命名為modCommon，修改窗體名為frmMain，同時修改工程名為projMain，然后保存到某個文件夾（譬如在桌面建立個文件夾Update），窗體、模塊和工程分別保存為frmMain.frm、modCommon.bas、projMain.vbp；

2.        建立工程projNewMain：點擊菜單“文件|新建工程” ，選擇“標(biāo)準(zhǔn)EXE”，點擊菜單“工程|添加模塊”，在彈出的對話框中選擇“現(xiàn)存”標(biāo)簽，定位到Update文件夾，選中modCommon.bas模塊。修改窗體名為frmNewMain，同時修改工程名為projNewMain，然后保存到Update文件夾，窗體和工程分別保存為frmNewMain.frm、projNewMain.vbp；

3.        建立工程projUpdate：點擊菜單“文件|新建工程” ，選擇“標(biāo)準(zhǔn)EXE”，點擊菜單“工程|添加模塊”，在彈出的對話框中選擇“現(xiàn)存”標(biāo)簽，定位到Update文件夾，選中modCommon.bas模塊。修改窗體名為frmUpdate，同時修改工程名為projUpdate，然后保存到Update文件夾，窗體和工程分別保存為frmUpdate.frm、projUpdate.vbp；

4.        建立組：在工程projUpdate中，點擊菜單“文件|添加工程…”在彈出的對話框中選擇“現(xiàn)存”標(biāo)簽，定位到Update文件夾，選擇projMain.vbp；重復(fù)該動作，選擇projNewMain.vbp；保存該組即可；

5.        關(guān)閉工程，定位到Update文件夾，然后執(zhí)行下面的步驟。

各個工程文件中的文件源碼：

一、 projMain.vbp工程:

說明：這個是舊的主程序，從來沒有進(jìn)行過升級前的程序。

用記事本打開frmMain.frm文件，copy以下內(nèi)容到其中：

VERSION 5.00

Begin VB.Form frmMain

   Caption         =   "請點擊升級進(jìn)行程序"

   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

  ‘ 運(yùn)行更新程序

  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

  ‘ 記錄運(yùn)行狀態(tài)

  WritePrivateProfileString "Main", "Active", "-1", UpdateIniPath

  ‘ 記錄更新次數(shù)

  WritePrivateProfileString "Update", "Num", "0", UpdateIniPath

  Me.Caption = App.EXEName

End Sub

Private Sub Form_Unload(Cancel As Integer)

  ‘ 記錄運(yùn)行狀態(tài)

  WritePrivateProfileString "Main", "Active", "0", UpdateIniPath

End Sub

用記事本打開modCommon.bas文件，copy以下內(nèi)容到其中：

Attribute VB_Name = "modCommon"

Option Explicit

‘ ------------------------------------------

‘ 升級程序的例子

‘ 作者:   謝家峰

‘ 日期:   2003/12/19

‘

‘ 這里是通用模塊，放置API函數(shù)以及公用函數(shù)

‘

‘ ------------------------------------------

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

‘ ===============================================

‘ 從緩沖區(qū)中讀取字符串

‘

‘ ===============================================

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

‘ 改變標(biāo)簽的文本及位置

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

‘關(guān)閉窗體

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