用VB将WORD文档(或其他的二进制数据)生成xml文件并互相转换

    技术2022-05-11  136

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

    1.    建立一个新的vb工程

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

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

    代码:

    Option ExplicitDim oDoc As DOMDocumentDim DOCINPATH As StringDim XMLOUTPATH As StringDim DOCOUTPATH As StringPrivate 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 SubFunction 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 = arrBytesEnd FunctionPrivate 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 SubPrivate 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 IfEnd SubPrivate Sub Form_Unload(Cancel As Integer)    ReleaseObjectsEnd SubPrivate Sub ReleaseObjects()    Set oDoc = NothingEnd Sub

    4.    建立word文档DocInput.doc.

    5.    保存文档在工程目录下

    6.     运行程序点击cmdCreateXML 按钮.一个 XML 文件XmlOuput.xml 就建立了.点击 cmdGetBinary 按钮就可以生成word文档 DocOutput.doc.

         按照上面的方法,同样可以将任意的二进制数据存为xml,然后再重新生成二进制数据

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


    最新回复(0)