vba xml 怎么设置父节点_VBA编写Ribbon Custom UI编辑器04——解析xml

01 定义结构

目标是要把customUI.xml解析为二维数组，数组的第0行记录的是属性，第一列记录的是元素，其他地方存储的是属性的值。

同时因为xml本身是树形结构的，所以同时也记录下这些信息，这里使用左孩子右兄弟的结构来记录，所以，首先定义需要生成的数据结构：

'属性Public Type Attri    Key As String    value As StringEnd TypePublic Type Node    Left As Long '左孩子    Right As Long '右兄弟        '元素的名称    XMLItem As String    HasChild As Boolean        '属性数组    Attris() As Attri    '属性的数量    AttriNum As LongEnd TypePublic Type XML    Nodes() As Node    'Nodes实际存放的数量    nNode As LongEnd Type

解析xml最终需要返回的就是XML结构体。

02 状态机解析

要从Ribbon xml中解析元素、属性、属性的值，需要逐个去读取xml中的字符，判断状态，然后执行相应的操作。

这种需求非常的适合使用有限状态机的方法来组织代码，将每一个状态都编写成一个独立的函数，能简化代码的编写：

state	Char	Change state	备注
0	<	1	XML开始，初始化节点
1	非空白	2	开始读取XMLName
	/	9
2	空白	3	取出XMLName，开始找属性
	>	0	Stack.Push，开始读取Child的XML，设置HasChild属性为True
3	非空白	4	开始读取属性名称
4	=	5	取出属性名称，开始找属性的Value
5	"	6	开始读取属性Value
6	"	7	取出属性Value
7	空白	7
	>	0	Stack.Push，开始读取Child的XML，设置HasChild属性为True
	/	8	继续找到>
	其他字符	4	新的属性
8	>	0	结束1个，结束了一个不会有Child的
9	>	0	结束1个，Stack.Pop，记录弹出的XMLName，Stack.Top  = 0可以结束
99			出错状态，不需要做什么

类模块CXML代码：

Private Const INIT_NODE_NUM As Long = 100Private Const INIT_ATTRI_NUM As Long = 20Private Const Err_XML As String = "CXML：XML读取出错，这可能是Ribbon customUI.xml 不符合规范."'要解析的XML文本Private strXML As String'指向XML文本下一个要读取的位置Private pNext As Long'要返回的XML结构Private tXML As XML'记录XML.Nodes的下一个位置Private pNodeNext As Long'记录当前正在处理的Node在XML.Nodes中的IndexPrivate pNode As Long'记录状态Private state As Long'Stack中记录的是XML.Nodes的Index，方便处理父子关系Private s As CStack'XML文本长度Private iStrXMLLen As Long'解析一个XML文本到XML结构'sXML   XML文本'ret    返回的XML结构体'Return 返回出错信息Function Decode(sXML As String, ByRef ret As XML) As String    iStrXMLLen = VBA.Len(sXML)        If iStrXMLLen < 10 Then        Decode = "CXML：XML太短了"        Exit Function    End If    strXML = sXML        '解析XML，直到超过了文本长度    Do While pNext < iStrXMLLen        '使用CallByName调用相应状态的函数        state = VBA.CallByName(Me, "S" & VBA.CStr(state), VbMethod)        '99作为出错情况        If state = 99 Then            Decode = Err_XML            tXML.nNode = pNodeNext            ret = tXML            Exit Function        End If    Loop        tXML.nNode = pNodeNext    ret = tXMLEnd Function'读取下一个字符Private Function NextChar() As String    NextChar = VBA.Mid$(strXML, pNext, 1)    pNext = pNext + 1End FunctionPrivate Function NewNode() As Node    ReDim NewNode.Attris(INIT_ATTRI_NUM - 1) As AttriEnd Function'防止数组越界Private Function pNodeNextAdd() As Long    pNodeNext = pNodeNext + 1    If pNodeNext > UBound(tXML.Nodes) Then        ReDim Preserve tXML.Nodes(pNodeNext * 1.2)    End IfEnd FunctionPrivate Function AttriNumAdd(pNode As Long) As Long    tXML.Nodes(pNode).AttriNum = tXML.Nodes(pNode).AttriNum + 1    If tXML.Nodes(pNode).AttriNum > UBound(tXML.Nodes(pNode).Attris) Then        ReDim Preserve tXML.Nodes(pNode).Attris(tXML.Nodes(pNode).AttriNum * 1.2)    End IfEnd Function'记录树形结构信息Function SetParent(iParent As Long, iChild As Long) As Long    Dim i As Long        If tXML.Nodes(iParent).Left = 0 Then        tXML.Nodes(iParent).Left = iChild    Else        i = tXML.Nodes(iParent).Left        Do Until tXML.Nodes(i).Right = 0            i = tXML.Nodes(i).Right        Loop        tXML.Nodes(i).Right = iChild    End IfEnd FunctionPrivate Sub Class_Initialize()    ReDim tXML.Nodes(INIT_NODE_NUM - 1) As Node    Set s = New CStack    s.MaxSize = INIT_NODE_NUM        'String类型开始的下标是1    pNext = 1    '0作为root    pNodeNext = 1        s.Push 0End SubFunction S0() As Long    Do Until NextChar() = "        If pNext > iStrXMLLen Then S0 = 99: Exit Function    Loop        pNode = pNodeNext    pNodeNextAdd    tXML.Nodes(pNode) = NewNode()    '设置父节点的子节点    SetParent s.Top, pNode        S0 = 1End FunctionFunction S1() As Long    Dim tmp As String        tmp = NextChar()    Do Until tmp <> " "        If pNext > iStrXMLLen Then S1 = 99: Exit Function        tmp = NextChar()    Loop        tXML.Nodes(pNode).XMLItem = tmp    If tmp = "/" Then        S1 = 9    Else        S1 = 2    End IfEnd FunctionFunction S2() As Long    Dim tmp As String        tmp = NextChar()    Do Until tmp = " "        If pNext > iStrXMLLen Then S2 = 99: Exit Function                tXML.Nodes(pNode).XMLItem = tXML.Nodes(pNode).XMLItem & tmp        tmp = NextChar()        If tmp = ">" Then            s.Push pNode            tXML.Nodes(pNode).HasChild = True            S2 = 0            Exit Function        End If    Loop        S2 = 3End FunctionFunction S3() As Long    Dim tmp As String        tmp = NextChar()        Do Until tmp <> " "        If pNext > iStrXMLLen Then S3 = 99: Exit Function                tmp = NextChar()    Loop    tXML.Nodes(pNode).Attris(tXML.Nodes(pNode).AttriNum).Key = tmp        S3 = 4End FunctionFunction S4() As Long    Dim tmp As String        tmp = NextChar()        Do Until tmp = "="        If pNext > iStrXMLLen Then S4 = 99: Exit Function                tXML.Nodes(pNode).Attris(tXML.Nodes(pNode).AttriNum).Key = tXML.Nodes(pNode).Attris(tXML.Nodes(pNode).AttriNum).Key & tmp        tmp = NextChar()    Loop        S4 = 5End FunctionFunction S5() As Long    Dim tmp As String        tmp = NextChar()        Do Until tmp = """"        If pNext > iStrXMLLen Then S5 = 99: Exit Function                tmp = NextChar()    Loop        S5 = 6End FunctionFunction S6() As Long    Dim tmp As String        tmp = NextChar()        Do Until tmp = """"        If pNext > iStrXMLLen Then S6 = 99: Exit Function                tXML.Nodes(pNode).Attris(tXML.Nodes(pNode).AttriNum).value = tXML.Nodes(pNode).Attris(tXML.Nodes(pNode).AttriNum).value & tmp        tmp = NextChar()    Loop    tXML.Nodes(pNode).AttriNum = tXML.Nodes(pNode).AttriNum + 1        S6 = 7End FunctionFunction S7() As Long    Dim tmp As String        tmp = NextChar()        Do Until tmp <> " "        If pNext > iStrXMLLen Then S7 = 99: Exit Function                tmp = NextChar()    Loop        If tmp = ">" Then        S7 = 0        tXML.Nodes(pNode).HasChild = True        s.Push pNode            ElseIf tmp = "/" Then        S7 = 8    Else        S7 = 4        tXML.Nodes(pNode).Attris(tXML.Nodes(pNode).AttriNum).Key = tmp    End IfEnd FunctionFunction S8() As Long    Do Until NextChar() = ">"        If pNext > iStrXMLLen Then S8 = 99: Exit Function    Loop        S8 = 0End FunctionFunction S9() As Long    Dim tmp As String        tmp = NextChar()        Do Until tmp = ">"        If pNext > iStrXMLLen Then S9 = 99: Exit Function                tXML.Nodes(pNode).XMLItem = tXML.Nodes(pNode).XMLItem & tmp        tmp = NextChar()    Loop    s.Pop        If s.Top = 0 Then        S9 = 10    Else        S9 = 0    End If    End FunctionFunction S10() As Long    'end    pNext = VBA.Len(strXML)End FunctionFunction S99() As Long    '出错了，什么也不用做End Function