VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "XMLWriter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'[sample]
'Dim xml As CLXML
'Set xml = New CLXML
'
'Call xml.BeginElement("a")
'Call xml.Element("b", "c")
'Call xml.EndElement
'
'MsgBox xml.xml


''' <summary>
''' XML文字列を格納する領域です。
''' </summary>
Private m_strXml As String

''' <summary>
''' 要素リストを格納する領域です。
''' </summary>
Private m_colElement As Collection

''' <summary>
''' コンストラクタ
''' </summary>
Private Sub Class_Initialize()

    m_strXml = "<?xml version=""1.0""?>" & vbCrLf
    Set m_colElement = New Collection

End Sub

''' <summary>
''' 要素を開始する
''' </summary>
Public Sub BeginElement(ByVal strTagName As String)

    strTagName = Replace(strTagName, "<", "")
    strTagName = Replace(strTagName, ">", "")
    strTagName = Replace(strTagName, """", "")

    m_strXml = m_strXml & String(m_colElement.Count, " ")
    m_strXml = m_strXml & "<" & strTagName & ">"
    m_strXml = m_strXml & vbCrLf
    Call m_colElement.Add(strTagName)

End Sub

''' <summary>
''' 要素を終了する
''' </summary>
Public Sub EndElement()

    If m_colElement.Count > 0 Then
        m_strXml = m_strXml & String(m_colElement.Count - 1, " ")
        m_strXml = m_strXml & "</" & m_colElement.Item(m_colElement.Count) & ">"
        m_strXml = m_strXml & vbCrLf
        Call m_colElement.Remove(m_colElement.Count)
    End If

End Sub

''' <summary>
''' 要素と値を追加する
''' </summary>
Public Sub Element(ByVal strTagName As String, ByVal strValue As String)

    strTagName = Replace(strTagName, "<", "")
    strTagName = Replace(strTagName, ">", "")
    strTagName = Replace(strTagName, """", "")
    strValue = Replace(strValue, "&", "&amp;")
    strValue = Replace(strValue, "<", "&lt;")
    strValue = Replace(strValue, ">", "&gt;")

    m_strXml = m_strXml & String(m_colElement.Count, " ")
    m_strXml = m_strXml & "<" & strTagName & ">"
    m_strXml = m_strXml & strValue
    m_strXml = m_strXml & "</" & strTagName & ">"
    m_strXml = m_strXml & vbCrLf

End Sub

''' <summary>
''' XMLを取得する
''' </summary>
Public Function xml() As String

    Dim i As Integer
    For i = 1 To m_colElement.Count
        Call EndElement
    Next

    xml = m_strXml

End Function

''' <summary>
''' XMLをファイルに保存する
''' </summary>
Public Function Save(ByVal strFilePath As String) As String
    Dim fp As Long

    fp = FreeFile
    Open strFilePath For Output Access Write Lock Read Write As #fp
    Print #fp, m_strXml
    Close #fp
    
End Function