用VB6.0編寫自我升級的程序(一)    douhapy（原作）  
  

 

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

 

以下是我的具體思路：

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

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

 

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

2.升級程序檢測舊的主程序是否活動，若活動則關閉舊的主程序（同時記下主程序的狀態）；

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

4.檢查主程序的狀態，若狀態為活動的，則啟動新的主程序；

5.關閉升級程序。

6.祝賀你，升級完成。

 

 

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

 

建立工程步驟：

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