用VB將WORD文件（或其他的二進位制資料）生成xml檔案並互相轉換 (轉)

用VB將WORD文件（或其他的二進位制資料）生成xml檔案並互相轉換 (轉)[@more@]

用vb將文件（或其他的二進位制資料）生成並互相轉換microsoft-com::office" />

1.  建立一個新的vb工程

2.  引用 Microsoft XML,版本 2.0 或以上

3.  在窗體form1上建立按鈕 cmdCreateXML 和 cmdGetBinary

程式碼：

Option Explicit
Dim oDoc As Document
Dim DOCINPATH As String
Dim XMLOUTPATH As String
Dim DOCOUTPATH As String

Private Sub cmdCreateXML_Click()
 
  Dim oEle As IXMLDOMElement
  Dim o As IXMLDOMElement
  Dim oNode As IXMLDOMNode
 
  DOCINPATH = App.Path & "DocInput.doc"
  XMLOUTPATH = App.Path & "XmlOuput.xml"
 
  Call Releases
 
  Set oDoc = New DOMDocument
  oDoc.resolveExternals = True
 
' Create processing instruction and document root
  Set oNode = oDoc.createProcessingInstruction("xml", "version='1.0'")
  Set oNode = oDoc.insertBefore(oNode, oDoc.childNodes.Item(0))
 
' Create document root
  Set oRoot = oDoc.createElement("Root")
  Set oDoc.documentElement = oRoot
  oRoot.setAttribute "xmlns:dt", "urn:schemas-microsoft-com:datatypes"

' Add a few simple nodes with different datatypes
  Set oNode = oDoc.createElement("Document")
  oNode.Text = "Demo"
  oRoot.appendChild oNode
 
  Set oNode = oDoc.createElement("CreateDate")
  oRoot.appendChild oNode
  Set oEle = oNode
 
' Use DataType so MSXML will validate the data type
  oEle.dataType = "date"
   
  oEle.nodeTypedValue = Now
 
  Set oNode = oDoc.createElement("bgColor")
  oRoot.appendChild oNode
  Set oEle = oNode
 
' Use DataType so MSXML will validate the data type
  oEle.dataType = "bin.hex"
 
  oEle.Text = &HFFCCCC
 
  Set oNode = oDoc.createElement("Data")
  oRoot.appendChild oNode
  Set oEle = oNode
 
' Use DataType so MSXML will validate the data type
  oEle.dataType = "bin.base64"
 
' Read in the data
  oEle.nodeTypedValue = ReainData(DOCINPATH)
 
' Save xml file
  oDoc.save XMLOUTPATH
 
  MsgBox XMLOUTPATH & " is created for you."
 
End Sub

Function ReadBinData(ByVal strFileName As String) As Variant
  Dim lLen As Long
  Dim iFile As Integer
  Dim arrBytes() As Byte
   Dim lCount As Long
  Dim strOut As String
 
'Read from disk
  iFile = FreeFile()
  Open strFileName For Binary Access Read As iFile
  lLen = FileLen(strFileName)
  ReDim arrBytes(lLen - 1)
  Get iFile, , arrBytes
  Close iFile
 
  ReadBinData = arrBytes
End Function

Private Sub WriteBinData(ByVal strFileName As String)
  Dim iFile As Integer
  Dim arrBuffer() As Byte
  Dim oNode As IXMLDOMNode
 
  If Not (oDoc Is Nothing) Then
 
' Get the data
  Set oNode = oDoc.documentElement.SingleNode("/Root/Data")

' Make sure you use a byte array instead of variant
  arrBuffer = oNode.nodeTypedValue
 
' Write to disk
 
  iFile = FreeFile()
  Open strFileName For Binary Access Write As iFile
  Put iFile, , arrBuffer
  Close iFile
 
  End If
 
End Sub

Private Sub cmdGetBinary_Click()
 
  DOCOUTPATH = App.Path & "DocOutput.doc"
 
  Set oDoc = New DOMDocument
 
  If oDoc.Load(XMLOUTPATH) = True Then
  ' Save the Doc as another file
  WriteBinData DOCOUTPATH
 
  MsgBox DOCOUTPATH & " is created for you."
  Else
  MsgBox oDoc.parseError.reason
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
  ReleaseObjects
End Sub

Private Sub ReleaseObjects()
  Set oDoc = Nothing
End Sub

4.  建立word文件DocInput.doc.

5.  儲存文件在工程目錄下

6.  執行點選cmdCreateXML 按鈕.一個 XML 檔案XmlOuput.xml 就建立了.
點選 cmdGetBinary 按鈕就可以生成word文件 DocOutput.doc.

  按照上面的方法，同樣可以將任意的二進位制資料存為xml，然後再重新生成二進位制資料

可以用於傳輸等等可以使用的地方