modify/beutify XML 文件或标签使用 vbscript?

modify/beutify XML file or tags using vbscript?

我有一个 XML 文件,格式如下:

<payments/>
    <payment>
        <payment_type>
        </payment_type>
        <dataforpay>
        </dataforpay>
        <allocations/>
            <allocation>
                <id>
                </id>
                <notfind>
                </notfind>
                <amount>
                </amount>
            </allocation>
    </payment>

因为它看起来很高级的格式,我想用vbscript把这个格式更新到下面.....请给点建议?

<payments>
    <payment>
        <payment_type>
        </payment_type>
        <dataforpay>
        </dataforpay>
        <allocations>
            <allocation>
                <id>
                </id>
                <notfind>
                </notfind>
                <amount>
                </amount>
            </allocation>
        </allocations>
    </payment>
</payments>

原始格式无效 XML 因为它有 2 个根节点,所以我使用标准 Scripting.FileSystemObject 加载文件以防止 XML 解析错误的任何错误

Option Explicit

dim fso: set fso = CreateObject("Scripting.FileSystemObject")
dim stream: set stream = fso.OpenTextFile("input.xml")
dim xml: xml = stream.ReadAll()
stream.close

为了操作 XML,我将它加载到一个带有虚拟根节点的 MSXML2.DomDocument 中,因此它的格式正确

dim xmldoc: set xmldoc = CreateObject("MSXML2.DomDocument")
xmldoc.setProperty "SelectionLanguage", "XPath"
xmldoc.async = false
if not xmldoc.loadXML("<root>" & xml & "</root>") then
    WScript.Echo xmldoc.parseError.reason
    WScript.Quit
end if

然后我用XPath查询payments节点(假设只有一个)和payment节点(假设不止一个)

dim paymentsNode: set paymentsNode = xmldoc.selectSingleNode("//payments")
dim paymentNodes: set paymentNodes = xmldoc.selectNodes("//payment")

然后我遍历每个支付节点,然后查询 allocations 节点(假设只有一个)和 allocation 节点(假设不止一个)。每个 allocation 节点都从其父节​​点中删除并添加到 allocations 节点。然后对 payment.

进行同样的操作
dim p
for p = 0 to paymentNodes.length - 1
    dim payment: set payment = paymentNodes.Item(p)
    dim allocationsNode: set allocationsNode = payment.selectSingleNode("./allocations")
    dim allocationNodes: set allocationNodes = payment.selectNodes("./allocation")

    dim a
    for a = 0 to allocationNodes.length - 1
        dim allocation: set allocation = allocationNodes.Item(a)
        allocation.parentNode.removeChild allocation
        allocationsNode.appendChild allocation
    next

    payment.parentNode.removeChild payment
    paymentsNode.appendChild payment
next

因为 payments 节点现在是一个有效的根节点,我将 payment 级别的 XML 重新加载到 xmldoc 对象中以删除我们的临时 root 保存到磁盘之前的节点。

xmldoc.loadXML xmldoc.selectSingleNode("/root/payments").xml
xmldoc.save "output.xml"

直接节点操作的替代方法是使用 XSL Transform 但同样,您需要更正根节点。如果您的输入 XML 文件很大,这可能是更好的选择。

试试下面的代码。它找到名称为复数且后跟一对或多对具有相同单数名称的开闭标签的自闭标签,并用开闭对替换每个自闭标签,然后移入其中以下所有匹配的标签。

sCont = ReadTextFile("C:\Test\src.xml", -2)

With CreateObject("VBScript.RegExp")
    .Global = False
    .MultiLine = True
    .IgnoreCase = True
    Do
        ' pattern to match a self-closing tag with name in the plural followed by one or more pair of open-close tags with the same name in the singular
        .Pattern = "^[\r\n]*(\s*)<(\w+)s(\s+[^>]*)*/\s*>(\s*[\r\n]+)(\s*<(?:\s+[^>]*)*>[\s\S]*?</>)"
        If Not .Test(sCont) Then Exit Do
        ' replace matched self-closing tag with open-close pair, and moves first matched following tag into it 
        sCont = .Replace(sCont, "<s></s>")
        ' pattern to match a pair of open-close tags with name in the plural containing one or more, and followed by one or more pair of open-close tags with the same name in the singular
        .Pattern = "((?:^\s*)<(\w+)s(?:\s+[^>]*)*>\s*[\r\n]+\s*<(?:\s+[^>]*)*>[\s\S]*?</>\s*[\r\n]+)(^\s*</s>\s*[\r\n]+)(\s*<(?:\s+[^>]*)*>[\s\S]*?</>\s*[\r\n]+)"
        Do While .Test(sCont)
            ' move matched tag with the same name in the singular into
            sCont = .Replace(sCont, "")
        Loop
    Loop
End With

WriteTextFile sCont, "C:\Test\dst.xml", -2

Function ReadTextFile(sPath, iFormat)
    With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 1, False, iFormat)
        ReadTextFile = ""
        If Not .AtEndOfStream Then ReadTextFile = .ReadAll
        .Close
    End With
End Function

Sub WriteTextFile(sCont, sPath, iFormat)
    With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 2, True, iFormat)
        .Write(sCont)
        .Close
    End With
End Sub

请参阅使用 RegExp 解析 XHTML disclaimer