VBA/XML/Mapクラスを作ってみる① - UCSS_TIPS_AND_SAMPLES

---

Mapクラスサンプル

VB、VBAにはMapが無いので、XMLユーティリティクラスを使用して自作してみました。 これはString版

XmlCustomMap.cls

'Stringを格納できるMAP
Option Explicit

Const ELE_XML = "xml"
Const ELE_MAP = "map"
Const ATT_KEY = "key"
Const XPATH_MAP = ELE_XML + "/" + ELE_MAP
Private g_xml As XMLUtilClass

Public Sub putValue(ByVal x_key As String, ByVal x_value As String)
    Dim l_xpath As String
    Dim l_key As String
    l_key = x_key
    'XMLクラスが無ければ生成
    If g_xml Is Nothing Then
        newXml
    End If
    'null or ブランク は文字列"NULL"として扱う
    If IsNull(l_key) = True Or l_key = "" Then
        l_key = "NULL"
    End If
    'DELTE→INSERT
    '要素削除
    l_xpath = XPATH_MAP + "[@" + ATT_KEY + "='" + l_key + "']"
    g_xml.getNode (l_xpath)
    g_xml.removeNode
    'ルートへ移動
    g_xml.getNode (ELE_XML)
    '要素追加
    Call g_xml.addElement(ELE_MAP)
    '属性追加
    Call g_xml.setAttributeEx(ATT_KEY, l_key)
    '要素の値をセット
    Call g_xml.setNodeValue(x_value)
End Sub

Public Function getValue(ByVal x_key As String) As String
    Dim l_key As String
    Dim l_xpath As String
    l_key = x_key
    If g_xml Is Nothing Then
        getValue = ""
        Exit Function
    End If
    'null or ブランク は文字列"NULL"として扱う
    If IsNull(l_key) = True Or l_key = "" Then
        l_key = "NULL"
    End If
    l_xpath = XPATH_MAP + "[@" + ATT_KEY + "='" + l_key + "']"
    g_xml.getNode (l_xpath)
    getValue = g_xml.getNodeValueEx
End Function


Public Function containsKey(ByVal x_key As String) As Boolean
    Dim l_key As String
    Dim l As Long
    l_key = x_key
    'XMLクラスが無ければfalse
    If g_xml Is Nothing Then
        Exit Function
    End If
    'null or ブランク は文字列"NULL"として扱う
    If IsNull(l_key) = True Or l_key = "" Then
        l_key = "NULL"
    End If
    'XPathからセレクションノードを取得
    containsKey = (0 < g_xml.getSelectionNode(XPATH_MAP + "[@" + ATT_KEY + "='" + l_key + "']").Length)
End Function

Public Function size() As Long
    'XMLクラスが無ければ0
    If g_xml Is Nothing Then
        size = 0
        Exit Function
    End If
    'XPathからセレクションノードを取得
    size = g_xml.getSelectionNode(XPATH_MAP).Length
End Function

'keyをリストにして返す
Public Function getKeyList() As XmlCustomList
    Dim l_xpath As String
    Dim l_list As New XmlCustomList
    Dim n() As String
    Dim i As Integer
    l_xpath = XPATH_MAP
    If g_xml Is Nothing Then Exit Function
    g_xml.getSelectionNode (l_xpath)
    '全取得ノード分ループ
    Do While (Not g_xml.getNextNode() Is Nothing)
        '属性を全て取得
        n = g_xml.getAttributeValuesEx
        For i = 0 To UBound(n)
            l_list.add n(i)
        Next
    Loop
    Set getKeyList = l_list
End Function


Private Sub newXml()
    'XMLクラス
    Set g_xml = New XMLUtilClass
    'XML作成
    g_xml.createNewXML
    Call g_xml.addElement("xml")
End Sub

Private Sub Class_Terminate()
    Set g_xml = Nothing
End Sub