updatefile.frm

guan yu pai ke xi tong de ruan jian

                                If InStr(NameItem(1), "$(ProgramFiles)") > 0 Then
                                   '默认程序安装目录。
                                   PathStr = dl1.RegGetString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion", "ProgramFilesDir")
                                Else
                                    If InStr(NameItem(1), "$(CommonFilesSys)") > 0 Then
                                       '系统共享文件的公用目录。
                                       PathStr = dl1.RegGetString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion", "CommonFilesDir")
                                       If PathStr <> "" Then PathStr = PathStr & "\System"
                                    Else
                                        If InStr(NameItem(1), "$(MSDAOPath)") > 0 Then
                                           '数据访问对象(DAO)部件在注册表中的位置。
                                           PathStr = dl1.RegGetString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion", "CommonFilesDir")
                                           If PathStr <> "" Then PathStr = PathStr & "\Microsoft Shared\DAO"
                                        Else
                                            If InStr(NameItem(1), "$(Font)") > 0 Then
                                               '字体目录。
                                               PathStr = dl1.RegGetString(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", "Fonts")
                                            Else
                                                If InStr(NameItem(1), "$(CommonFiles)") > 0 Then
                                                    '用户共享文件的公用目录。
                                                   PathStr = dl1.RegGetString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion", "CommonFilesDir")
                                                Else
                                                    '这里还可以处理其他安装宏。
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    End If
                    If PathStr <> "" Then '表示是可以识别的更新文件路径才处理。
                        '这里对文件进行处理。
                        DownFileCount = DownFileCount + 1
                        ReDim Preserve LodownFileObjNow(6, DownFileCount)
                        For ForIndex = 0 To 6
                            If ForIndex > UBound(NameItem) Then Exit For
                            LodownFileObjNow(ForIndex, DownFileCount - 1) = NameItem(ForIndex)
                        Next
                        '要下载的文件名列表。
                        LodownFileObjNow(0, DownFileCount - 1) = Right(NameItem(0), Len(NameItem(0)) - InStr(NameItem(0), "@"))
                        '取得安装相对路径（安装宏后面的内容）。
                        PathLen = InStr(NameItem(1), "\")
                        '更新文件地址列表.
                        If PathLen > 0 Then
                            LodownFileObjNow(1, DownFileCount - 1) = PathStr & "\" & Right(NameItem(1), Len(NameItem(1)) - PathLen) & "\" & LodownFileObjNow(0, DownFileCount - 1)
                        Else
                            LodownFileObjNow(1, DownFileCount - 1) = PathStr & "\" & LodownFileObjNow(0, DownFileCount - 1)
                        End If
                        '这里检查文件大小、版本及修改时间,如果不一致才更新.
                        Set hFile = fso.GetFile(LodownFileObjNow(1, DownFileCount - 1))
                        If Format(hFile.DateCreated, "yyyy-mm-dd hh:mm:ss") = Format(LodownFileObjNow(4, DownFileCount - 1), "yyyy-mm-dd hh:mm:ss") Then
                            '修改时间相同.
                            If hFile.Size = Val(LodownFileObjNow(5, DownFileCount - 1)) Then
                                '文件大小相同.
                                If fso.GetFileVersion(LodownFileObjNow(1, DownFileCount - 1)) = LodownFileObjNow(6, DownFileCount - 1) Then '版本相同.
                                    '这样的文件不必更新.
                                    DownFileCount = DownFileCount - 1
                                End If
                            End If
                        End If
                    End If
                End If
                DoEvents
            Loop
            File.Close
            fso.DeleteFile dl1.SaveLocation '即时删除更新信息文件。
            MsgAdd "需更新文件总数:" & DownFileCount
            If DownFileCount > 0 Then '有一个以上文件需更新，则启动文件下载更新过程。
                DownIndex = DownIndex + 1
                DownFileName = LodownFileObjNow(0, DownIndex - 1)
                DownStart '开始下载。
            End If
    Case Else
        '继续下载，真到下载完所有文件。
        DownIndex = DownIndex + 1
        If DownIndex <= DownFileCount Then
            DownFileName = LodownFileObjNow(0, DownIndex - 1)
            DownStart
            Exit Sub
        End If
        '到这里表示全部下载结束！添加更新文件的代码。
        If MainWinClose("翰林排课", "ThunderRT6Main") = True Then '搜索排课助手窗体，并关闭。
            MsgAdd "发现[翰林排课]没有关闭！请关闭后重新进行升级操作！"
            Me.Timer2.Enabled = True
            Me.Command1(1).Visible = True
            Exit Sub
        End If
        'MsgBox "下载结束，更新文件..."
        If UpdateFileData = True Then
            MsgAdd "升级失败过程中出现了一些错误！你可能需要手动排除这些错误!"
            Me.Command1(2).Visible = True
            Me.Command1(2).Caption = "关闭"
            Me.Command1(1).Visible = False
            Me.Command1(0).Visible = False
        Else
            '将版本信息保存在注册表中。
            dl1.RegSaveString ServerPath, , , "URL"
            MsgAdd "升级操作结束！"
            Me.Caption = "翰林排课助手升级程序----升级成功"
            Me.Timer2.Enabled = True
        End If
    End Select
End Sub
Private Function UpdateFileData() As Boolean
    '更新并注册文件。
    '拷贝文件，并判断是否拷贝成功。
    Dim UpdateIndex As Long
    Dim TemNum As Long
    For UpdateIndex = 0 To DownFileCount - 1
        If Len(LodownFileObjNow(2, UpdateIndex)) > 0 Then '说明文件需要注册.
            If LodownFileObjNow(2, UpdateIndex) = "$(DLLSelfRegister)" Then 'DLL/OCX注册类型.
                TemNum = CopyFile(DownPath & LodownFileObjNow(0, UpdateIndex), LodownFileObjNow(1, UpdateIndex), True)
                If TemNum = 0 Then '拷贝成功。
                    MsgAdd "更新" & LodownFileObjNow(1, UpdateIndex) & "成功。"
                    '注册更新后的文件.
                    If Register_DLL_OCX(LodownFileObjNow(1, UpdateIndex)) = True Then '注册成功。
                        MsgAdd "注册" & LodownFileObjNow(1, UpdateIndex) & "成功。"
                    Else
                        MsgAdd "错误:------注册" & LodownFileObjNow(1, UpdateIndex) & "失败。"
                    End If
                Else
                    MsgAdd "错误:------更新" & LodownFileObjNow(1, UpdateIndex) & "失败。"
                End If
            Else '其他注册类型.
                MsgAdd "错误:------未识别的注册类型!"
            End If
        Else '文件不需要注册.
            TemNum = CopyFile(DownPath & LodownFileObjNow(0, UpdateIndex), LodownFileObjNow(1, UpdateIndex), True)
            If TemNum = 0 Then '拷贝成功。
                MsgAdd "更新" & LodownFileObjNow(1, UpdateIndex) & "成功。"
            Else
                MsgAdd "错误:------更新" & LodownFileObjNow(1, UpdateIndex) & "失败。"
            End If
        End If
    Next
End Function
Private Sub dl1_StatusChange(lpStatus As String)
    '获取及时消息。
    MsgAdd (lpStatus)
End Sub
Private Sub dl1_RecievedBytes(lnumBYTES As Long)
    '获取已经下载的字节。
    ProgressBar1.Max = dl1.FileSize
    ProgressBar1.Value = lnumBYTES
End Sub
Private Sub dl1_Rate(lpRate As String)
    '获取连接速度?
    Me.Label1.Caption = "连接速度:" & lpRate
End Sub

Private Sub dl1_TimeLeft(lpTime As String)
    '获取剩余时间。
    Me.Label2.Caption = "估计剩余时间:" & lpTime
End Sub
Private Sub DownStart()
    If dl1.InDL = True Then
        MsgAdd ("前一个下载尚未结束!")
        Exit Sub '如果正处于接收中则不能再启动接收。
    End If
    Me.ProgressBar1.Value = 0
    dl1.Url = ServerPath & DownFileName
    dl1.SaveLocation = DownPath & DownFileName
    dl1.GetFileInformation '获取文件信息。
    dl1.DownLoad  '开始下载。
End Sub
Private Sub MsgAdd(MsgStr As String)
    Me.Text1.Text = Me.Text1.Text & MsgStr & vbCrLf
    Me.Text1.SelStart = Len(Me.Text1.Text)
End Sub

Private Sub Timer1_Timer()
    '启动5秒后自动启动更新程序。
    '首先关闭主程序(标题为“翰林排课”的所有窗体)。
    Dim ClassName As String * 255
    Me.Timer1.Enabled = False
    '注意保证目录存在！
    Dim fso As New FileSystemObject
    Me.Command1(0).Visible = True
    Me.Command1(1).Visible = False
    Me.Label1.Caption = ""
    Me.Label2.Caption = ""
    If fso.FolderExists(DownPath) = False Then '如果临时文件夹不存在，则建立。
        dl1.CreatFolder (DownPath)
        If fso.FolderExists(DownPath) = False Then
            MsgBox "权限不够，无法升级文件。请与你的管理员联系。"
            Unload Me
            Exit Sub
        End If
    End If
    DownFileCount = 0
    Me.Text1.Text = ""
    DownIndex = 0 '表示第一个文件。这个文件表示版本号，以确定是否需要升级。
    DownFileName = "setup.lst" '远程升级信息文件名称。
    MsgAdd ("开始升级..." & vbCrLf & "连接网络检查版本信息...")
    DownStart
End Sub
Private Sub Timer2_Timer()
    Me.Command1(0).Visible = False
    Me.Command1(2).Visible = True
    Me.Command1(2).Caption = "(" & Val(Right(Me.Command1(2).Caption, Len(Me.Command1(2).Caption) - 1)) - 1 & ")关闭"
    If Val(Right(Me.Command1(2).Caption, Len(Me.Command1(2).Caption) - 1)) <= 0 Then
        Me.Timer2.Enabled = False
        Unload Me
    End If
End Sub