frmupdate.frm

程序自动更新。具有请看里边内容。 实在自动更新。删除替换

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

         Charset         =   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

     

     ' 摸拟从网站下载新的更新程序。

     ChangeLabelPos Me, lblCap, "正在 摸拟从网站下载新的升级程序 ..."

     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