frmupdate.frm

用VB6制作的在线升级程序,仅供参考,各位爱好者可以在源码基础上进行完善

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

' 这里是升级程序

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", "1"))

     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