與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的文件讀寫不太熟悉，這裏僅實現了想要的功能，沒有再去深究。
這就是上篇，更新程序的編寫，下一步計劃寫中篇（主程序的更新檢測）及下篇（更新發布程序的編），敬請繼續關注。