用vb将word文档（或其他的二进制数据）生成xml文件并互相转换

　　 
　　用vb将word文档（或其他的二进制数据）生成xml文件并互相转换

1.    建立一个新的vb工程

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

3.    在窗体form1上建立按钮 cmdCreateXML 和 cmdGetBinary

代码：

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

Private Sub cmdCreateXML_Click()
    
    Dim oEle As IXMLDOMElement
    Dim oRoot As IXMLDOMElement
    Dim oNode As IXMLDOMNode
        
    DOCINPATH = App.Path & "DocInput.doc"
    XMLOUTPATH = App.Path & "XmlOuput.xml"
          
    Call ReleaseObjects
    
    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 = ReadBinData(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 Aclearcase/" target="_blank" >ccess 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.selectSingleNode("/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，然后再重新生成二进制数据

可以用于web传输等等可以使用xmlhttp的地方

原文转自：http://www.ltesting.net