用VB6写在线更新程序（上篇）(3/3)

与Delphi中不同的是，读取一个结点的属性值时，要判断属性的存在性，试图读取返回的空值将引发错误。

解析得到的值保存在XmlConfiguration类的属性中，而文件列表通过一个数组来保存。这里又遇到一个问题：索引属性，这个概念不好解释，还是看代码吧：

 

' Files(文件列表)属性

Public Property Get Files(Index As Integer) As XMLFile

    Set Files = List(Index)

End Property

 

 

 

 

 

这里并不实现写(Let)属性，而是通过AddFile方法实现添加文件到列表（似乎只许添加，不许修改了），当然提供清空的方法是必要的：

 

'{ 添加一个文件到文件列表。Cable Fan 2009-08-18 }

Public Sub AddFile(AName As String, ATarget As String, AVersion As String, ADate As Date, AMain As Boolean)

    Dim j As Integer

    j = UBound(List)

    ReDim Preserve List(j + 1)

    Set List(j) = New XMLFile

    List(j).FileName = AName

    List(j).Target = ATarget

    List(j).FileVersion = AVersion

    List(j).FileDate = ADate

    List(j).FileMain = AMain

End Sub

 

'{ 清空文件列表。Cable Fan 2009-08-17 }

Public Sub ClearFiles()

    If UBound(List) <= 0 Then Exit Sub

   

    Dim i As Integer

    For i = UBound(List) - 1 To 0 Step -1

        Set List(i) = Nothing

    Next

    ReDim List(0)

End Sub

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

悲哀的是，在写这个类时，没未找到用API函数SafeArrayGetDim判断VB空数组主方法，使用1个元素的数组来表示空，后来也懒得改回去了，所以List数组至少会有一个元素（流汗ing…）！

这里还用到一个自定义类：XMLFile，里面只定义了FileName、Target、FileVersion、FileDate与FileMain四个读写属性，对应XML配置文件中文件结点的name、target、version、date与main属性。在Delphi里定义一个record（记录）类型就可以，VB中我试过定义一个Type（类型）的，但好像不行。会提示下面的错误（不好意思，装的英文版本，慢慢翻译），郁闷！

 

 

 

至此，XmlConfiguration类对于更新程序是够用了，但为了类定义的完整，也为了在发布程序调用，还是要定义一下Save方法，将XML配置写入到XML文件中：

 

'{ 将XML配置保存到文件。Cable Fan 2009-08-17 }

Public Function Save(ConfigFile As String) As Boolean

    On Error GoTo CATCH

   

    ' 回写配置值。

    Dim i As Integer

    Dim Root As IXMLDOMNode

    Dim Node As IXMLDOMNode

    Dim ItemNode As IXMLDOMNode

   

    Set Root = XmlDoc.documentElement

    If Root Is Nothing Then

        ' 创建仅有根结点的空白XML框架。

        XmlDoc.loadXML "<?xml version=""1.0"" encoding=""gb2312""?><update/>"

        Set Root = XmlDoc.documentElement

    End If

   

    ' 更新版本信息。

    Set Node = GetChildNode(Root, "publish")

    ' Force

    Set ItemNode = GetChildNode(Node, "force")

    ItemNode.Text = IIf(m_Force, "1", "0")

    ' PublishDate

    Set ItemNode = GetChildNode(Node, "publishDate")

    ItemNode.Text = Format(m_PublishDate, "yyyy-MM-dd hh:mm:ss")

    ' Version

    Set ItemNode = GetChildNode(Node, "version")

    ItemNode.Text = m_Version

    ' Remark

    Set ItemNode = GetChildNode(Node, "remark")

    ItemNode.Text = m_Remark

    ' Run

    Set ItemNode = GetChildNode(Node, "run")

    ItemNode.Text = m_RunCmd

   

    ' 更新路径配置。

    Set Node = GetChildNode(Root, "paths")

     ' ConfigUrl

    Set ItemNode = GetChildNode(Node, "configUrl")

    SetNodeAttr ItemNode, "url", m_ConfigUrl

     ' ConfigPath

    Set ItemNode = GetChildNode(Node, "configPath")

    SetNodeAttr ItemNode, "path", m_ConfigPath

     ' BaseUrl

    Set ItemNode = GetChildNode(Node, "baseUrl")

    SetNodeAttr ItemNode, "url", m_BaseUrl

     ' LocalPath

    Set ItemNode = GetChildNode(Node, "localPath")

    SetNodeAttr ItemNode, "url", m_LocalPath

     ' RemotePath

    Set ItemNode = GetChildNode(Node, "remotePath")

    SetNodeAttr ItemNode, "url", m_RemotePath

                

    '{ 更新文件列表。}

    Set Node = GetChildNode(Root, "files")

   

    ' 清空所有文件项。

    For i = Node.childNodes.Length - 1 To 0 Step -1

        Node.removeChild Node.childNodes(i)

    Next

   

    ' 依据列表添加文件项。

    For i = 0 To UBound(List) - 1

        Dim AXmlFile As XMLFile

        Set AXmlFile = List(i)

        Set ItemNode = XmlDoc.createElement("file")

        Set ItemNode = Node.appendChild(ItemNode)

       

        SetNodeAttr ItemNode, "name", AXmlFile.FileName

        If AXmlFile.Target <> "" And AXmlFile.FileName <> AXmlFile.Target Then

            SetNodeAttr ItemNode, "target", AXmlFile.Target

        End If

        If AXmlFile.FileMain Then SetNodeAttr ItemNode, "main", "1"

        If AXmlFile.FileVersion <> "" Then

            SetNodeAttr ItemNode, "version", AXmlFile.FileVersion

        Else

            SetNodeAttr ItemNode, "date", AXmlFile.FileDate

        End If

    Next

       

    XmlDoc.Save (ConfigFile)

    Save = True

   

    Exit Function

CATCH:

    MsgBox "无法保存XML配置。" & vbCrLf & Err.Description

    Save = False

End Function

 

'{ 查找并创建(如果不存在)指定结点指定名称的属性，并更新属性为指定值。Cable Fan 2009-08-17 }

Private Sub SetNodeAttr(Node As IXMLDOMNode, AttrName As String, AttrValue As String)

    Dim Attr As IXMLDOMNode

    Set Attr = Node.Attributes.getNamedItem(AttrName)

    If Attr Is Nothing Then

        Set Attr = XmlDoc.createAttribute(AttrName)

        Set Attr = Node.Attributes.setNamedItem(Attr)

    End If

    Attr.nodeValue = AttrValue

End Sub

 

'{ 查找并创建(如果不存在)指定结点中指定名称的子结点。Cable Fan 2009-08-17 }

Private Function GetChildNode(PNode As IXMLDOMNode, S As String) As IXMLDOMNode

    Dim i As Integer

    Dim Node As IXMLDOMNode

   

    For i = 0 To PNode.childNodes.Length - 1

        Set Node = PNode.childNodes(i)

        If Node.nodeName = S Then

            Set GetChildNode = Node

            Exit Function

        End If

    Next

   

    Set Node = XmlDoc.createElement(S)

    Set Node = PNode.appendChild(Node)

    Set GetChildNode = Node

End Function

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

这个方法是Analysis的逆过程，但相比复杂一些，因为保存时要查找对应的子结点，如果找不到（不存在）还要创建一个新的结点；类似地，结点属性也需要这样做。如果连XML配置文件都不存在，还要创建一个空的XML文档框架。而查找结点用GetChildNode函数，这个函数会在指定的父结点下查找指定名称的子结点，如果找不到则创建一个新的子结点并返回；同理，设置属性用SetNodeAttr函数，它会查找指定结点指定名称的属性，如果不存在也会创建新的属性，并将属性值设置指定的值。

至此，XmlConfiguration就算完成了，接下来是依据文件列表逐个比较文件的版本号（或最后修改日期），需要更新的，则从指定路径将文件下载下来将旧文件覆盖。这里要注意一点：下载的源路径中加入了time参数，指定当前时间，目的在于防止Windows自动从缓存中直接下载以前下载的旧文件。

 

'{ 开始执行下载更新。Cable Fan 2009-08-13 }

Private Sub StartUpdate()

    ' 处理更新配置文件。

    Dim AppPath As String ' 程序安装目录

    Dim SourceFile As String ' 源文件(不含路径)。

    Dim DestFile As String ' 目标文件(含路径)。

    Dim UpdateNeeded As Boolean ' 是否需要更新。

   

    AppPath = ExtractFilePath(AppFile)

    Print #FileLog, "更新下载地址“" & XmlConfig.BaseUrl & "”。"

    Print #FileLog, "程序安装路径“" & AppPath & "”。"

   

    Print #FileLog, "待下载更新文件数：" & XmlConfig.FileCount

    ' 获取下载文件列表

    Dim i As Integer

For i = 0 To XmlConfig.FileCount – 1

    If Canceled Then Exit For ‘ 取消时退出循环。

 

        SourceFile = XmlConfig.Files(i).FileName

        Print #FileLog, "正在准备更新文件(" & i + 1 & "/" & XmlConfig.FileCount & ")：“" & SourceFile & "”。"

       

        If XmlConfig.Files(i).FileMain Then

            DestFile = AppFile

            Print #FileLog, "下载更新主程序：“" & DestFile & "”。"

        Else

            DestFile = AppPath & XmlConfig.Files(i).Target

            Print #FileLog, "下载更新一般文件：“" & DestFile & "”。"

        End If

       

        ' 检查文件版本。

        lblStatus.Caption = "正在检查文件版本..."

        lblFile.Caption = "当前文件：" & SourceFile

        UpdateNeeded = False

        If XmlConfig.Files(i).FileVersion = "" Then ' 无版本号的文件比较文件修改时间。

            UpdateNeeded = (XmlConfig.Files(i).FileDate > GetFileModifiedDate(DestFile))

            Print #FileLog, "比较文件修改时间。"

        Else

            UpdateNeeded = (CompareVersion(XmlConfig.Files(i).FileVersion, GetFileVersion(DestFile)) > 0)

            Print #FileLog, "比较文件版本号。"

        End If

       

        ' 按需要下载文件。

        If UpdateNeeded Then

            lblStatus.Caption = "正在下载文件..."

            lblFile.Caption = "当前文件：" & SourceFile

            If URLDownloadToFile(Me, XmlConfig.BaseUrl & SourceFile & "?time=" & _

                Format(Now, "yyyyMMddhhmmss"), DestFile, 0, Me) = 0 Then

                Print #FileLog, "下载成功。"

            Else

                Print #FileLog, "下载失败。"

            End If

        Else

            Print #FileLog, "无需更新。"

            lblStatus.Caption = "文件无需更新..."

            lblFile.Caption = "当前文件：" & SourceFile

        End If

       

        DoEvents

    Next

   

    ' 下载后运行命令。

    RunCmdLine XmlConfig.RunCmd

   

    ' 启动主程序。

    Print #FileLog, "启动更新后的主程序：“" & AppFile & "”。"

    lblStatus.Caption = "正在启动程序..."

    If FileExists(AppFile) Then Shell AppFile, vbNormalFocus

   

    ' 结束更新程序。

    Finished = True

    lblStatus.Caption = "正在结束更新程序..."

    Timer1.Interval = 2000 ' 延迟2000毫秒结束程序。

    Timer1.Enabled = True

End Sub

 

'{ 执行命令行。Cable Fan 2009-08-15 }

Private Sub RunCmdLine(CmdLine As String)

    On Error GoTo CATCH

    Print #FileLog, "下载后执行命令行：“" & CmdLine & "”。"

    If CmdLine <> "" Then WinExec CmdLine, 1

    Print #FileLog, "执行命令行：“" & CmdLine & "”成功。"

    Exit Sub

CATCH:

    Print #FileLog, "执行命令行：“" & CmdLine & "”时失败：" & Err.Description

End Sub

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

这里用到3个（可能更多，中篇中一并贴出）函数：一个是获取文件版本号的函数GetFileVersion；一个是获取文件最后修改时间的函数GetFileModifiedDate，还有一个是用来比较两个版本号新旧的函数CompareVersion。由于本篇写得太长了，留到中篇（中篇也太短了！）吧。最后用到的函数RunCmdLine，是用于运行DOS命令的，需要用到WinExec（还是API函数，晕）。

而这里的难点是下载进度提示的实现，窗体中放置了进度条ProgressBar1，而要实现单个文件下载进度的显示，需将窗体本身（在其它类实现这个接口我没搞定，有点深奥）定义为实现IBindStatusCallback接口，在窗口开头写上这一句即可（在网上搜了很久才找到的方法，挺别扭的^_^）：

Implements olelib.IBindStatusCallback

然后实现IBindStatusCallback的OnProgress方法（相当于写事件处理过程），实现对进度提示的更新：

 

'{ 更新显示下载进度状态。Cable Fan 2009-08-13 }

Private Sub IBindStatusCallback_OnProgress(ByVal ulProgress As Long, ByVal ulProgressMax As Long, ByVal ulStatusCode As olelib.BINDSTATUS, ByVal szStatusText As Long)

    If ulProgressMax > 0 Then

        If InProgress Then

            InProgress = False

            lblStatus.Caption = "正在下载文件(" & Format(ulProgress / ulProgressMax, "0%") & ")..."

            lblStatus.Refresh

        End If

        ProgressBar1.Min = 0: ProgressBar1.Max = ulProgressMax: ProgressBar1.Value = ulProgress

    End If

    'DoEvents

End Sub

 

 

 

 

 

 

 

 

 

 

 

 

 

这里还要用到olelib.tlb文件，也是网上搜了的，似乎比较稀有。既然进度条有了，当然也少不了取消按钮（下载进程及久时让人有取消的机会还是很必要滴！这是友好界面的标准，呵呵，自吹一下）。当然，为了更加方便于更新程序的高度与错误检查，还实现了更新日志（文本）文件的记录，对VB的文件读写不太熟悉，这里仅实现了想要的功能，没有再去深究。

这就是上篇，更新程序的编写，下一步计划写中篇（主程序的更新检测）及下篇（更新发布程序的编），敬请继续关注。