updatefile.frm

guan yu pai ke xi tong de ruan jian

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form UpdateFile 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "排课助手升级程序——正在升级..."
   ClientHeight    =   5445
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6525
   Icon            =   "UpdateFile.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   363
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   435
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   1080
      Top             =   840
   End
   Begin FileUpdate.DownLoad dl1 
      Left            =   120
      Top             =   240
      _ExtentX        =   847
      _ExtentY        =   847
   End
   Begin VB.CommandButton Command1 
      Caption         =   "(50)关闭"
      Height          =   375
      Index           =   2
      Left            =   5280
      TabIndex        =   6
      ToolTipText     =   "关闭"
      Top             =   5040
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "继续升级"
      Height          =   375
      Index           =   1
      Left            =   4080
      TabIndex        =   5
      Top             =   5040
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   840
      Top             =   120
   End
   Begin VB.CommandButton Command1 
      Caption         =   "取消"
      Height          =   375
      Index           =   0
      Left            =   5280
      TabIndex        =   1
      Top             =   5040
      Width           =   1215
   End
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   4560
      Width           =   6495
      _ExtentX        =   11456
      _ExtentY        =   661
      _Version        =   393216
      BorderStyle     =   1
      Appearance      =   0
      Scrolling       =   1
   End
   Begin VB.TextBox Text1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000000&
      Height          =   4455
      Left            =   0
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   2
      Top             =   0
      Width           =   6495
   End
   Begin VB.Label Label2 
      Height          =   375
      Left            =   2160
      TabIndex        =   4
      Top             =   5040
      Width           =   3855
   End
   Begin VB.Label Label1 
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Top             =   5040
      Width           =   2415
   End
End
Attribute VB_Name = "UpdateFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'将ST6UNST.LOG中的ACTION: PrivateFile: 改为ACTION: SharedFile: 就可解决共享问题!
'而且还要在注册表HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\SharedDlls中建立相应DWORD键值,数据为1.

Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const HKEY_CURRENT_USER = &H80000001
Private Const LOGON_REG_VER = "Software\Helper\Apply"
Dim DownPath As String  ' = "C:\Temp\" '下载文件临时存放目录。
Dim ServerPath As String  '= "http://www.growchina.cn/PaikeFileUpdate/" '远程文件目录。
Dim DownIndex As Integer
Dim DownFileName As String
Dim DownFileCount As Long '保存下载文件总数。
Dim LodownFileObjNow() As String '保存下载列表。
Private Sub Form_Load()
    '临时文件夹设置。
    Dim TemString As String * 255
    Dim TemNum As Long
    TemNum = GetTempPath(255, TemString)
    DownPath = Left(TemString, TemNum)
    If Right(DownPath, 1) <> "\" Then DownPath = DownPath & "\"
    '远程更新地址设置。
    ServerPath = dl1.RegGetString(, , "URL")
    If Len(ServerPath) < 8 Then ServerPath = "http://www.growchina.cn/PaikeFileUpdate"
    If Right(ServerPath, 1) <> "/" Then ServerPath = ServerPath & "/"
End Sub
Private Sub Command1_Click(index As Integer)
    Select Case index
    Case 0
        dl1.Cancel
        Unload Me
    Case 1:
        If UpdateFileData = True Then
            MsgAdd "升级失败！"
        Else
            MsgAdd "升级操作结束！"
            Me.Caption = "翰林排课助手升级程序----升级成功"
        End If
        Me.Timer2.Enabled = True
    Case 2:
        Unload Me
    End Select
End Sub

Private Sub dl1_DLError(Number As Long, Description As String)
    MsgAdd ("错误" & Number & ":" & Description)
    Me.Timer2.Enabled = True
End Sub

Private Sub dl1_DLComplete()
    '下载完成。这里可以放入代码处理后续任务。
On Error Resume Next
    Dim intfile As Integer
    Dim VerNumber As String
    Dim TemData As Byte
    Dim ReadIndex As Long
    Dim fso As New FileSystemObject
    Dim File As TextStream
    Dim hFile As File
    Dim Folder As Folder
    Dim TemStr As String
    Dim PathStr As String
    Dim PathLen As Long
    Dim NameItem() As String
    Dim ForIndex As Long
    Select Case DownIndex
    Case 0: '说明是下载安装信息文件(setup.lst)。
            '通过读取setup.lst文件的[Setup1 Files]节，获取要更新下载的文件列表。
            Set File = fso.OpenTextFile(dl1.SaveLocation)
            If File Is Nothing Then
                MsgAdd "打开信息文件失败,升级失败!"
                Me.Timer2.Enabled = True
                Exit Sub
            End If
            Do While File.AtEndOfStream = False
                TemStr = File.ReadLine
                If LCase(Left(TemStr, 4)) = "file" Then '说明是要更新的文件列表。
                    NameItem = Split(TemStr, Chr(44)) '以逗号分隔各项。
                    '根据安装宏确定目标路径。
                    PathStr = ""
                    If InStr(NameItem(1), "$(AppPath)") > 0 Then '说明是程序安装目录(注意主程序与更新程序安装在同一目录)。
                        '安装目录。
                        PathStr = App.Path
                    Else
                        If InStr(NameItem(1), "$(WinSysPathSysFile)") > 0 Or InStr(NameItem(1), "$(WinSysPath)") > 0 Then
                            '系统文件目录。
                            PathStr = String(255, " ")
                            PathLen = GetSystemDirectory(PathStr, 255)
                            PathStr = Left(PathStr, PathLen)
                        Else
                            If InStr(NameItem(1), "$(WinPath)") > 0 Then
                                '系统安装目录。
                                PathStr = String(255, " ")
                                PathLen = GetWindowsDirectory(PathStr, 255)
                                PathStr = Left(PathStr, PathLen)
                            Else