XMLを扱う場合は、MSXMLのXmlDocument あたりを
利用することが多いと思います。
しかし。
AB上からは、これら(COM?)の呼び方がイマイチ分からない/複雑。┐(-ε-)┌
というわけで、同じI/FのクラスをAB用に作成してみました。
XPathを使う必要性に迫られたので、その辺を中心に。
極力同じメソッド名&操作性にしているので、他の言語(VC++,VB,C#等)で
本来のMSXMLを利用する際も混乱しないと思います。
# あ、特殊記号「&'<>'」は内部で勝手にエンティティと変換します。
# なので、クラス越しにXMLを読み書きする際は、そのまま直に記号を扱えます。
# そこは本家MSXML利用より便利かも?
(※当方が必要とするメソッド/メンバしか実装/定義してませんのでアシカラズ)。
1.作成クラスの概要
■WsAB_XmlNodeクラス [ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]
⇒a) XmlNodeクラス相当。
b)追加のライブラリは不要。
c)基底クラス:無し
d)メソッド:
Function SelectSingleNode( pszXPath As BytePtr ) As *WsAB_XmlNode
Function RemoveChild( pobjOldChild As WsAB_XmlNodePtr ) As Char
Function AppendChild( pobjNewChild As WsAB_XmlNodePtr ) As *WsAB_XmlNode
Function Name() As BytePtr
Function Name( pszNewName As BytePtr ) As BytePtr
Function Value() As BytePtr
Function Value( pszNewValue As BytePtr ) As BytePtr
e)メソッド:
FirstChild As *WsAB_XmlNode
2.クラスの定義(コード)
※長いのでここをクリック [ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード:
/*
[WSLib7_XmlDoc.sbp]
【WSLib7.sbpが必須】
WsAB_XmlDocument・・・XmlDocumentクラスオブジェクト
--> 基底クラス:XmlNodeクラス
WsAB_XmlDocument_NoAddLibクラス
--> メソッド:
Function Load( pszFilePath As BytePtr ) As Char
--> '成功時はTRUE、失敗するとFALSE。
'※文字コードはShift-JISのみサポート。
Function Save( pszFilePath As BytePtr ) As Char
--> '成功時はTRUE、失敗するとFALSE。
'※文字コードはShift-JISのみサポート。
【追加Libは不要】
WsAB_XmlNodePtr ・・・XmlNodeクラスポインタ
--> 基底クラス:無し
--> メソッド:
Function SelectSingleNode( pszXPath As BytePtr ) As WsAB_XmlNodePtr
--> XPathは "/", "./", "../" の何れかで始まるもののみサポート。
"[~]"は添え字と"text()='~'"のみサポート。Contains()は【未サポート】。
"@"も一応サポート、のはず・・・。
"./hoge[text()='target']/var"はサポートするが、
"./hoge[var/text()='innder']/var"は【未サポート】なので注意。
"../"は一階層上がるXPathとしてサポート。
"../../"という繰り返しや"./hoge/"というタグ名指定無し型は【未サポート】なので注意。
Function RemoveChild( pobjOldChild As WsAB_XmlNodePtr ) As Char
Function AppendChild( pobjNewChild As WsAB_XmlNodePtr ) As WsAB_XmlNodePtr
Function Name() As BytePtr
Function Name( pszNewName As BytePtr ) As BytePtr
Function Value() As BytePtr
Function Value( pszNewValue As BytePtr ) As BytePtr
--> プロパティ(メンバ):
FirstChild As *WsAB_XmlNode
WsAB_XmlDocument_NoAddLib ・・・XmlDocumentクラスオブジェクトのベース。
--> 基底クラス:XmlNodeクラス
--> メソッド:
Function LoadXml( pszXmlText As BytePtr ) As Char
--> '成功時はTRUE、失敗するとFALSE。
'※文字コードはShift-JISのみサポート。
*/
#ifndef XML_DOC
#define XML_DOC
Class WsAB_XmlDocument
Inherits WsAB_XmlDocument_NoAddLib
Public
Sub WsAB_XmlDocument()
'hDocHeap : 基底クラス WsAB_XmlDocument_NoAddLib のヒープハンドル。
End Sub
Sub ~WsAB_XmlDocument()
End Sub
Function Load( pszFilePath As BytePtr ) As Char
Dim objFile As WsFileReadWrite
Load = objFile.OpenFile( pszFilePath )
If Load Then
Load = This.LoadXml( objFile.GetContents() )
End If
End Function
Function Save( pszFilePath As BytePtr ) As Char
Dim objFile As WsFileReadWrite
Dim strLcl_ProcessingInstruction_Version As String
Dim strBuf As String
strLcl_ProcessingInstruction_Version = Ex"<?xml version=\q1.0\q encoding=\qShift_JIS\q?>"
Save = objFile.WriteContents_Open( pszFilePath )
strBuf = strLcl_ProcessingInstruction_Version + Ex"\r\n"
objFile.WriteContents_Packet( strBuf, Len(strBuf) )
Save_Parts( pThisRootNode, 0, TRUE, VarPtr(objFile) )
objFile.WriteContents_Close()
End Function
Private
Function Save_Parts( pCurr As *Ws_XmlDoc_St_Node, nTabIndent As Long, fTagColsed As BytePtr, pobjOutFile As *WsFileReadWrite ) As Char
Dim pParent As *Ws_XmlDoc_St_Node
Dim pPrev As *Ws_XmlDoc_St_Node
Dim pChild As *Ws_XmlDoc_St_Node
Dim fLastChildText As Char
Dim strBuf As String
Dim pIn As BytePtr
Dim pOut As BytePtr
If pCurr<>NULL Then
Select Case pCurr->dwNodeType
Case WsAB_Cnst_Node_Element
If fTagColsed=FALSE Then
strBuf = Ex">\r\n"
pobjOutFile->WriteContents_Packet( strBuf, Len(strBuf) )
fTagColsed = TRUE
End If
If NULL<>pCurr->pNodeChild Then
strBuf = String$( nTabIndent*2, " " ) + "<" + MakeStr( pCurr->pszItem )
pobjOutFile->WriteContents_Packet( strBuf, Len(strBuf) )
fLastChildText = Save_Parts( pCurr->pNodeChild, nTabIndent + 1, FALSE, pobjOutFile )
If fLastChildText Then
strBuf = "</" + MakeStr( pCurr->pszItem ) + Ex">\r\n"
Else
strBuf = String$( nTabIndent*2, " " ) + "</" + MakeStr( pCurr->pszItem ) + Ex">\r\n"
End If
pobjOutFile->WriteContents_Packet( strBuf, Len(strBuf) )
Else
strBuf = String$( nTabIndent*2, " " ) + "<" + MakeStr( pCurr->pszItem ) + Ex" />\r\n"
pobjOutFile->WriteContents_Packet( strBuf, Len(strBuf) )
End If
fLastChildText = FALSE
Case WsAB_Cnst_Node_Attribute
If fTagColsed=FALSE Then
strBuf = " " + MakeStr( pCurr->pszItem ) + Ex"=\q"
If NULL<>pCurr->pNodeChild Then
pChild = pCurr->pNodeChild
If NULL<>pChild->pszItem Then
strBuf = strBuf + MakeStr( pChild->pszItem )
End If
strBuf = strBuf + Ex"\q"
pobjOutFile->WriteContents_Packet( strBuf, Len(strBuf) )
End If
fTagColsed = FALSE
Else
'想定外の呼び出し。
End If
fLastChildText = FALSE
Case WsAB_Cnst_Node_Text
If fTagColsed=FALSE Then
strBuf = Ex">"
pobjOutFile->WriteContents_Packet( strBuf, Len(strBuf) )
fTagColsed = TRUE
End If
strBuf = MakeStr( pCurr->pszItem )
pIn = StrPtr( strBuf )
Do
pOut = lstrchr_Xml( pIn, 38 )
If pOut<>NULL Then
pOut[0] = NULL
pobjOutFile->WriteContents_Packet( pIn, lstrlen(pIn) )
pobjOutFile->WriteContents_Packet( "&", 5 )
pIn = pOut + 1
Else
pOut = lstrchr_Xml( pIn, 60 )
If pOut<>NULL Then
pOut[0] = NULL
pobjOutFile->WriteContents_Packet( pIn, lstrlen(pIn) )
pobjOutFile->WriteContents_Packet( "<", 4 )
pIn = pOut + 1
Else
pOut = lstrchr_Xml( pIn, 62 )
If pOut<>NULL Then
pOut[0] = NULL
pobjOutFile->WriteContents_Packet( pIn, lstrlen(pIn) )
pobjOutFile->WriteContents_Packet( ">", 4 )
pIn = pOut + 1
Else
pOut = lstrchr_Xml( pIn, 39 )
If pOut<>NULL Then
pOut[0] = NULL
pobjOutFile->WriteContents_Packet( pIn, lstrlen(pIn) )
pobjOutFile->WriteContents_Packet( """, 6 )
pIn = pOut + 1
Else
pOut = lstrchr_Xml( pIn, 34 )
If pOut<>NULL Then
pOut[0] = NULL
pobjOutFile->WriteContents_Packet( pIn, lstrlen(pIn) )
pobjOutFile->WriteContents_Packet( "'", 6 )
pIn = pOut + 1
Else
pobjOutFile->WriteContents_Packet( pIn, lstrlen(pIn) )
Exit Do
End If
End If
End If
End If
End If
Loop
fLastChildText = TRUE
Case Else
'No Action:ありえない。
End Select
If NULL<>pCurr->pNodeNext Then
fLastChildText = Save_Parts( pCurr->pNodeNext, nTabIndent, fTagColsed, pobjOutFile )
End If
End If
Save_Parts = fLastChildText
End Function
End Class
Type Ws_XmlDoc_St_Node
dwNodeType As DWord
pNodePrev As *Ws_XmlDoc_St_Node
pNodeNext As *Ws_XmlDoc_St_Node
pNodeChild As *Ws_XmlDoc_St_Node
pNodeParent As *Ws_XmlDoc_St_Node
pszItem As BytePtr
pXmlNode As *WsAB_XmlNode
End Type
TypeDef Ws_XmlDoc_St_Node_Ptr = *Ws_XmlDoc_St_Node
Const WsAB_Cnst_Node_Element = 1
Const WsAB_Cnst_Node_Attribute = 2
Const WsAB_Cnst_Node_Text = 3
Const WsAB_XmlDoc_NodeType_Text = "text"
Const WsAB_XmlDoc_NodeType_Elem = "element"
Const WsAB_XmlDoc_NodeType_Attr = "attribute"
Class WsAB_XmlDocument_NoAddLib
Inherits WsAB_XmlNode
Public
Sub WsAB_XmlDocument_NoAddLib()
WsAB_XmlNode( NULL, NULL )
hDocHeap = HeapCreate( NULL, 0, 0 )
pThisDoc = NULL
pThisCreateNodeRoot = CreateNode_Parts( WsAB_XmlDoc_NodeType_Elem, "crt_root", "" )
pThisCreateNodeLast = pThisCreateNodeRoot
pThisRootNode = NULL
End Sub
Sub ~WsAB_XmlDocument_NoAddLib()
NodeStDel( hDocHeap, pThisCreateNodeRoot )
If pThisRootNode<>NULL Then
NodeStDel( hDocHeap, pThisRootNode )
pThisRootNode = NULL
End If
HeapDestroy( hDocHeap )
End Sub
Function CreateElement( pszElemName As BytePtr ) As WsAB_XmlNodePtr
CreateElement = CreateNode( WsAB_XmlDoc_NodeType_Elem, pszElemName, NULL )
End Function
Function CreateTextNode( pszText As BytePtr ) As WsAB_XmlNodePtr
CreateTextNode = CreateNode( WsAB_XmlDoc_NodeType_Text, pszText, NULL )
End Function
Function CreateNode( pszNodeTypeString As BytePtr, pszName As BytePtr, pszNamespaceURI As BytePtr ) As WsAB_XmlNodePtr
Dim pCrt As *Ws_XmlDoc_St_Node
Dim pobjXmlNode As WsAB_XmlNodePtr
pCrt = CreateNode_Parts( pszNodeTypeString, pszName, "" )
pobjXmlNode = New WsAB_XmlNode( hDocHeap, pCrt )
If pThisCreateNodeLast=pThisCreateNodeRoot Then
pThisCreateNodeRoot->pNodeChild = pCrt
Else
pThisCreateNodeLast->pNodeNext = pCrt
pCrt->pNodePrev = pThisCreateNodeLast
End If
pCrt->pNodeParent = pThisCreateNodeRoot
pCrt->pXmlNode = pobjXmlNode
pThisCreateNodeLast = pCrt
CreateNode = pobjXmlNode
End Function
Function LoadXml( pszXmlText As BytePtr ) As Char
Dim pXml_NoBrankOmit As BytePtr
Dim pCurr As *Ws_XmlDoc_St_Node
Dim pParent As *Ws_XmlDoc_St_Node
Dim pPrev As *Ws_XmlDoc_St_Node
Dim pEnd As BytePtr
Dim pMark As BytePtr
Dim pTagNameIn As BytePtr
Dim pTagNameOut As BytePtr
Dim n As Long
Dim b As Byte
Dim pszAttrBuf As BytePtr
'【未実装】pThisDoc にXML内容を読み込む。
'空要素を<elem />の形に統一。
'※<elem />は処理できるが、<elem/>は処理できない都合による。
pXml_NoBrankOmit = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, 2*lstrlen( pszXmlText )*SizeOf(Byte) ) As BytePtr
ConvertBrankWhSpc( pXml_NoBrankOmit, pszXmlText )
'属性取得用のバッファ確保
pszAttrBuf = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, (lstrlen( pXml_NoBrankOmit )+1)*SizeOf(Byte) ) As BytePtr
'パラメータの初期化(準備)。
pMark = pXml_NoBrankOmit
pEnd = pMark + lstrlen( pMark )
If pThisRootNode<>NULL Then
NodeStDel( hDocHeap, pThisRootNode )
pThisRootNode = NULL
End If
pPrev = NULL
pCurr = NULL
pParent = NULL
pTagNameIn = NULL
pTagNameOut = NULL
LoadXml = FALSE
'ノード構造体へ分解していく。
While pMark =< pEnd
Select Case pMark[0]
Case 0 '=NULL
'正常終了
If pThisRootNode<>NULL Then
LoadXml = TRUE
Else
LoadXml = FALSE
End If
Exit While
Case 60 '=[<]
'タグの開始を見つけた。
pTagNameIn = pMark + 1
Case 63 '=[?]
If 60=GetByte( pMark-1 ) Then '=[<]
'※XML宣言とか。開始タグ情報を解除する。
pTagNameIn = NULL
End If
Case 33 '=[!]
If 0=memcmp( pMark-1, "<!", 2 ) Then
'※コメントの処理。開始タグ情報を解除したうえで、コメント終端まで読み飛ばす。
pTagNameIn = NULL
pMark = lstrstr_Xml( pMark+1 , "-->" )
End If
Case 47 '=[/]
If 62=GetByte( pMark+1 ) Then '=[>]
'タグ終端@空要素だった。
'⇒そのまま親ノードを閉じる。
pPrev = pParent
If pParent<>NULL Then
pParent = pParent->pNodeParent
End If
pCurr = NULL
pTagNameIn = NULL
pTagNameOut = NULL
Else If 60=GetByte( pMark-1 ) Then '=[<]
'閉タグの開始を見つけた。
'⇒テキストがあるかをチェックしてから親ノードを閉じる。
'※開始タグとの一致をチェックする
If pParent<>NULL Then
If pParent->pszItem <> NULL Then
If 0<>memcmp( pParent->pszItem, pMark+1, lstrlen(pParent->pszItem) ) Then
Exit While
End If
End If
End If
If pTagNameOut<>NULL and pTagNameOut<>pMark-1 Then
'テキストが在るっぽい。
'※上記は空要素でないことも考慮してます。
'テキストの前後の改行、タブ、半角スペースは外す。
pTagNameIn = pTagNameOut
pTagNameOut = pMark - 2
While ( pTagNameIn[0]=13 or pTagNameIn[0]=10 or pTagNameIn[0]=9 or pTagNameIn[0]=32 ) and pTagNameIn < pTagNameOut
pTagNameIn++
Wend
While ( pTagNameOut[0]=13 or pTagNameOut[0]=10 or pTagNameIn[0]=9 or pTagNameIn[0]=32 ) and pTagNameIn < pTagNameOut
pTagNameOut--
Wend
pTagNameOut++
'ノード@テキストを新規作成&内容格納。
b = pTagNameOut[0]
pTagNameOut[0] = NULL
pCurr = CreateNode_Parts( WsAB_XmlDoc_NodeType_Text, pTagNameIn, "" )
pTagNameOut[0] = b
'前後のノードに接続。
If pPrev=NULL Then
pParent->pNodeChild = pCurr
pCurr->pNodePrev = NULL
Else
pPrev->pNodeNext = pCurr
pCurr->pNodePrev = pPrev
End If
pCurr->pNodeNext = NULL
pCurr->pNodeChild = NULL
pCurr->pNodeParent = pParent
End If
'親ノードを閉じる。
pPrev = pParent
If pParent<>NULL Then
pParent = pParent->pNodeParent
End If
pCurr = NULL
pTagNameIn = NULL
pTagNameOut = NULL
End If
Case 32, 61, 62 '=[ ], [=], [>]
'要素名/属性名の終わりっっぽい。
If pTagNameIn<>NULL Then
'ノードを新規に作成して、タグ名を格納。
n = pMark - pTagNameIn
b = pMark[0]
pMark[0] = NULL
pCurr = CreateNode_Parts( WsAB_XmlDoc_NodeType_Elem, pTagNameIn, "" )
pMark[0] = b
'直前の兄弟ノードに接続。
If pPrev<>NULL Then
pPrev->pNodeNext = pCurr
pCurr->pNodePrev = pPrev
pCurr->pNodeParent = pParent '親は必ずつなぐ:直ぐ上に上がれるように。
Else
'兄弟が居ない=親。ルートの場合もある。
If pThisRootNode=NULL Then
'ルートとして設定。
pThisRootNode = pCurr
pThisRootNode->pNodePrev = NULL
pThisRootNode->pNodeNext = NULL
pThisRootNode->pNodeParent = NULL
Else
'親ノードに接続
If pParent->pNodeChild=NULL Then
pParent->pNodeChild = pCurr
End If
pCurr->pNodeParent = pParent
pCurr->pNodePrev = NULL
End If
End If
'作成したノードに対する処理を終える。
pParent = pCurr
pCurr = NULL
pPrev = NULL
'属性値を考慮
Select Case b
Case 32
'属性値が続くかも。
pTagNameIn = pMark + 1
pTagNameOut = NULL
Case 61 '=[=]
'今のが属性値だった。
pParent->dwNodeType = WsAB_Cnst_Node_Attribute
'ノード@テキストに内容を格納。
n = GetAttrText( pMark + 2, pszAttrBuf )
pCurr = CreateNode_Parts( WsAB_XmlDoc_NodeType_Attr, pszAttrBuf, "" )
pMark = pMark + 2 + n + 1
'前後のノードを接続
pParent->pNodeChild = pCurr
pCurr->pNodeNext = NULL
pCurr->pNodePrev = NULL
pCurr->pNodeChild = NULL
pCurr->pNodeParent = pParent
If pMark[0]=32 Then
'さらに、属性値が続くかも。
pTagNameIn = pMark + 1
pTagNameOut = NULL
Else
'属性もう無し=タグ名を抜けた。
pTagNameIn = NULL
pTagNameOut = lstrchr_Xml( pMark, 62 ) '=[>] ※エラー処理すべき?
pTagNameOut = pMark + 1
End If
'属性を閉じる。
pPrev = pParent
pParent = pParent->pNodeParent
pCurr = NULL
Case Else
'属性もう無し=タグ名を抜けた。
pTagNameIn = NULL
pTagNameOut = pMark + 1
End Select
End If
End Select
pMark++
Wend
'ノード構造体の個々に個々のXmlNodeオブジェクトを関連付ける。
'※ルートについては、こいつと下記の基底クラスとが二つ接続
' ただし、構造体側から見えるのはこっちだけ。
ConnectBoth_NodeStTree( pThisRootNode )
'規定クラスのXmlNodeへ接続。
'※先に上記のTreeを作成しておくこと。
ConnectStNode( pThisRootNode )
HeapFree( hDocHeap, 0, pszAttrBuf )
HeapFree( hDocHeap, 0, pXml_NoBrankOmit )
End Function
Protected
hDocHeap As HANDLE
pThisDoc As BytePtr
pThisRootNode As *Ws_XmlDoc_St_Node
pThisCreateNodeRoot As *Ws_XmlDoc_St_Node
pThisCreateNodeLast As *Ws_XmlDoc_St_Node
'※pszNamespaceURIは現時点では無意味。
Function CreateNode_Parts( pszNodeTypeString As BytePtr, pszName As BytePtr, pszNamespaceURI As BytePtr ) As WsAB_XmlNodePtr
Dim pobjCurr As *Ws_XmlDoc_St_Node
Dim n As Long
Dim i As Long
Dim j As Long
pobjCurr = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, SizeOf(Ws_XmlDoc_St_Node) ) As Ws_XmlDoc_St_Node_Ptr
If 0=lstrcmp( pszNodeTypeString, WsAB_XmlDoc_NodeType_Elem ) Then
n = lstrlen( pszName )
pobjCurr->pszItem = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, (n+1)*SizeOf(Byte) ) As BytePtr
lstrcpy( pobjCurr->pszItem, pszName )
pobjCurr->dwNodeType = WsAB_Cnst_Node_Element
Else If 0=lstrcmp( pszNodeTypeString, WsAB_XmlDoc_NodeType_Attr ) Then
n = lstrlen( pszName )
pobjCurr->pszItem = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, (n+1)*SizeOf(Byte) ) As BytePtr
lstrcpy( pobjCurr->pszItem, pszName )
pobjCurr->dwNodeType = WsAB_Cnst_Node_Attribute
Else If 0=lstrcmp( pszNodeTypeString, WsAB_XmlDoc_NodeType_Text ) Then
n = lstrlen( pszName )
If NULL=lstrchr_Xml( pszName, 38 ) Then '=[&]
pobjCurr->pszItem = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, (2*n+1)*SizeOf(Byte) ) As BytePtr
lstrcpy( pobjCurr->pszItem, pszName )
Else
n = n * 2 + 1
pobjCurr->pszItem = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, n*SizeOf(Byte) ) As BytePtr
i = 0
j = 0
While j<n
Select Case pszName
Case NULL
Exit While
Case 38 '=[&]=[&]
If 0=memcmp( pszName+i, "&", 5 ) Then
pobjCurr->pszItem[j] = 38
i += 4
Else If 0=memcmp( pszName+i, ">", 4 ) Then
pobjCurr->pszItem[j] = 62
i += 3
Else If 0=memcmp( pszName+i, "<", 4 ) Then
pobjCurr->pszItem[j] = 60
i += 3
Else If 0=memcmp( pszName+i, """, 6 ) Then
pobjCurr->pszItem[j] = 39
i += 3
Else If 0=memcmp( pszName+i, "'", 6 ) Then
pobjCurr->pszItem[j] = 34
i += 3
Else
pobjCurr->pszItem[j] = pszName
End If
Case Else
pobjCurr->pszItem[j] = pszName
End Select
i++
j++
Wend
pobjCurr->pszItem[j] = NULL
End If
pobjCurr->dwNodeType = WsAB_Cnst_Node_Text
End If
CreateNode_Parts = pobjCurr
End Function
'保持しているノード構造体ツリーに、XmlNodeオブジェクトを関連付ける。
Sub ConnectBoth_NodeStTree( pNodeSt As *Ws_XmlDoc_St_Node )
Dim dwNodeNum As DWord
Dim pXmlNode As *WsAB_XmlNode
Dim pParent As *Ws_XmlDoc_St_Node
Dim pPrev As *Ws_XmlDoc_St_Node
If pNodeSt<>NULL Then
If NULL<>pNodeSt->pNodeChild Then
ConnectBoth_NodeStTree( pNodeSt->pNodeChild )
End If
If NULL<>pNodeSt->pNodeNext Then
ConnectBoth_NodeStTree( pNodeSt->pNodeNext )
End If
pXmlNode = New WsAB_XmlNode( hDocHeap, pNodeSt )
pNodeSt->pXmlNode = pXmlNode
End If
End Sub
'属性の["]で囲まれた内容をString型で得る。
Function GetAttrText( pStart As BytePtr, pszAttrBuf As BytePtr ) As Long
Dim p As BytePtr
Dim n As Long
p = pStart
While p[0]<>NULL and p[0]<>34 '=["]
p++
Wend
If p[0]<>NULL Then
p[0] = NULL
lstrcpy( pszAttrBuf, pStart )
n = lstrlen( pszAttrBuf )
p[0] = 34
pszAttrBuf[n] = NULL
GetAttrText = n
Else
GetAttrText = 0
End If
End Function
'空要素の整形<elem /> or <elem/> ⇒ <elem /> ※空白は一つだけ!
Sub ConvertBrankWhSpc( pszXmlTextOut As BytePtr, pszXmlTextIn As BytePtr )
Dim pIn As BytePtr
Dim pOut As BytePtr
Dim pCat As BytePtr
pCat = pszXmlTextOut
pIn = pszXmlTextIn
pOut = lstrstr_Xml( pIn, "/>" )
While pOut<>NULL
pOut[0] = NULL
lstrcpy( pCat, pIn )
pCat += lstrlen( pCat )
pOut[0] = 47 '=[/]
pIn = pOut + 2
pCat--
While pCat[0]=32 '=[ ]
pCat--
Wend
pCat++
pCat[0] = NULL
lstrcpy( pCat, " />" )
pCat += lstrlen( pCat )
pOut = lstrstr_Xml( pIn, "/>" )
Wend
lstrcpy( pCat, pIn )
End Sub
End Class
TypeDef WsAB_XmlNodePtr = *WsAB_XmlNode
Const WsAB_XmlNode_NodeType_Text = "#text"
Const WsAB_XmlNode_NodeType_Elem = "#element"
Const WsAB_XmlNode_NodeTyep_Attr = "#attribute"
Const WsAB_XmlNode_SpcialXPath = "getNodeSt()"
Class WsAB_XmlNode
Public
Sub WsAB_XmlNode( hParentHeap As HANDLE, pstDoc_St_Node As *Ws_XmlDoc_St_Node )
If hParentHeap=NULL Then
hXmlNodeHeap = HeapCreate( NULL, 0, 0 )
fXmlNodeHeap = TRUE
Else
hXmlNodeHeap = hParentHeap
fXmlNodeHeap = FALSE
End If
'初期化
pNodeConnectSt = pstDoc_St_Node
pszInnerText = NULL
pszThisNodeName = NULL
pszValue = NULL
'各種プロパティに値を設定。
CreatePropatry()
End Sub
Sub ~WsAB_XmlNode()
If fXmlNodeHeap Then
HeapDestroy( hXmlNodeHeap )
End If
End Sub
Public
FirstChild As *WsAB_XmlNode
Function Name() As BytePtr
Name = pszThisNodeName
End Function
Function Name( pszNewName As BytePtr ) As BytePtr
If NULL<>This.Name() Then
HeapFree( hXmlNodeHeap, 0, pNodeConnectSt->pszItem )
pNodeConnectSt->pszItem = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, 1+lstrlen( pszNewName ) ) As BytePtr
pszThisNodeName = pNodeConnectSt->pszItem
lstrcpy( pszThisNodeName, pszNewName )
Name = pszThisNodeName
Else
Name = NULL
End If
End Function
Function Value() As BytePtr
Value = pszValue
End Function
Function Value( pszNewValue As BytePtr ) As BytePtr
If NULL<>This.Value() Then
HeapFree( hXmlNodeHeap, 0, pNodeConnectSt->pszItem )
pNodeConnectSt->pszItem = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, 1+lstrlen( pszNewValue ) ) As BytePtr
pszValue = pNodeConnectSt->pszItem
lstrcpy( pszValue, pszNewValue )
Value = pszValue
Else
Value = NULL
End If
End Function
'書き換えは許可しない。
Function NodeType_Ws() As BytePtr
NodeType_Ws = pszNodeType_Ws
End Function
Function InnerText() As BytePtr
'未実装
'pszInnerText = NULL
End Function
Function InnerText( pszNewText As BytePtr ) As BytePtr
'未実装
End Function
Function SelectSingleNode( pszXPath As BytePtr ) As WsAB_XmlNodePtr
'※分割することで、何かコーディングしやすい部分が
' 在るかと思ったのだが、、、現時点ではなかった。。。
' ⇒正規化とかに使えるかな?(./省略形への対応)
If 0=lstrcmp( pszXPath, WsAB_XmlNode_SpcialXPath ) Then
'※特殊XPath:内部保持しているノード構造体を返す。
SelectSingleNode = pNodeConnectSt As WsAB_XmlNodePtr
Else
SelectSingleNode = SelectSingleNode_Parts( pszXPath )
End If
End Function
Function RemoveChild( pobjOldChild As WsAB_XmlNodePtr ) As Char
If pobjOldChild=VarPtr( This ) Then
RemoveChild = NodeStDel( NULL, pNodeConnectSt )
Else
RemoveChild = pobjOldChild->RemoveChild( pobjOldChild )
Delete pobjOldChild
End If
End Function
Function AppendChild( pobjNewChild As WsAB_XmlNodePtr ) As WsAB_XmlNodePtr
Dim pobjNodeStLst As Ws_XmlDoc_St_Node_Ptr
Dim pobjNodeStSrc As Ws_XmlDoc_St_Node_Ptr
Dim pobjNodeStNew As Ws_XmlDoc_St_Node_Ptr
pobjNodeStSrc = pobjNewChild->SelectSingleNode( WsAB_XmlNode_SpcialXPath ) As Ws_XmlDoc_St_Node_Ptr
pobjNodeStNew = CloneNodeSt( hXmlNodeHeap, pobjNodeStSrc, NULL )
pobjNodeStLst = pNodeConnectSt->pNodeChild
If pobjNodeStLst=NULL Then
'子ノードが無い⇒新規に追加。
pNodeConnectSt->pNodeChild = pobjNodeStNew
Else
'子ノードがある⇒一番末っ子を探してから追加。
While NULL <> pobjNodeStLst->pNodeNext
pobjNodeStLst = pobjNodeStLst->pNodeNext
Wend
pobjNodeStLst->pNodeNext = pobjNodeStNew
pobjNodeStNew->pNodePrev = pobjNodeStLst
pobjNodeStNew->pNodeNext = NULL
End If
'自分にとっての親は、常に設定する。
pobjNodeStNew->pNodeParent = pNodeConnectSt
AppendChild = pobjNodeStNew->pXmlNode
End Function
#ifdef XML_NODE_DEBUG
Function GetRootDebug() As *Ws_XmlDoc_St_Node
GetRootDebug = pNodeConnectSt
End Function
#endif
Protected
'ノード構造体の削除
Function NodeStDel( hParentHeap As HANDLE, pstNodeSt As *Ws_XmlDoc_St_Node ) As Char
Dim hHeap As HANDLE
Dim fCalledByOther As Char
Dim pParent As *Ws_XmlDoc_St_Node
Dim pPrev As *Ws_XmlDoc_St_Node
Dim pNext As *Ws_XmlDoc_St_Node
If pstNodeSt=NULL Then
Exit Function
End If
If hParentHeap=NULL Then
'省略=自分自身のクラスから呼ばれた、フラグとする。
hHeap = hXmlNodeHeap
fCalledByOther = FALSE
Else
'明示される=自分自身以外で呼ばれている、フラグとする。
hHeap = hParentHeap
fCalledByOther = TRUE
End If
'子供を全部削除
While NULL <> pstNodeSt->pNodeChild
'※子供への\削除指示=自分以外を削除、なのでHEAPハンドルを明示する。
NodeStDel( hHeap, pstNodeSt->pNodeChild )
Wend
'保持アイテムを削除
If pstNodeSt->pszItem<>NULL Then
HeapFree( hHeap, 0, pstNodeSt->pszItem )
pstNodeSt->pszItem = NULL
End If
'前後の兄弟から切り離す。
'※これを、保持アイテム削除のあとにしないと【コンパイラ】がバグる。。。
pPrev = pstNodeSt->pNodePrev
pNext = pstNodeSt->pNodeNext
If NULL=pPrev Then
'前の兄弟が居ない=親から認識されている長男
'⇒自分の次の兄弟を親に接続しなおす。
pParent = pstNodeSt->pNodeParent
If pParent<>NULL Then
'自分の次の兄弟を親に接続しなおす。
'※自分側の親認識は常にあるので、再設定不要。
pParent->pNodeChild = pNext
'↑ここ、Debug実行だと、何故かpstNodeSt自身が書き換わる。。。
' ⇒つまり、pNext=0だと、pstNodeSt=0 とかふざけたことに。。。
If NULL<>pNext Then
'次の兄弟から、自分を切り離す。
pNext->pNodePrev = NULL
End If
Else
'親設定無し=ルート:何もしない。
End If
Else
'前の兄弟から、自分を切り離す。
pPrev->pNodeNext = pNext
'自分が末っ子でなければ、自分の前後の兄弟をつなぎ、自分を切り離す。
If NULL<>pNext Then
pNext->pNodePrev = pPrev
End If
End If
'関連付けられているXmlNodeオブジェクトを破棄。
If fCalledByOther Then
If pstNodeSt->pXmlNode<>NULL Then
Delete pstNodeSt->pXmlNode
pstNodeSt->pXmlNode = NULL
End If
End If
'自分自身を削除
'※最後にNULL指定するが、実際は上の兄弟からの切り離しでNULLアウトされるので不要。
NodeStDel = HeapFree( hHeap, 0, pstNodeSt )
pstNodeSt = NULL
End Function
'ノード構造体を、本クラスへ関連付ける。
Sub ConnectStNode( pstDoc_St_Node As *Ws_XmlDoc_St_Node )
'対応するノード構造体のポインタを保持。
pNodeConnectSt = pstDoc_St_Node
'各種プロパティに値を設定。
CreatePropatry()
'親ノード構造体は、この時点では不明。
pNodeRootSt = NULL
End Sub
'各種プロパティに値を設定。
Sub CreatePropatry()
If pNodeConnectSt<>NULL Then
If pNodeConnectSt->pNodeChild <>NULL Then
FirstChild = pNodeConnectSt->pNodeChild->pXmlNode
Else
FirstChild = NULL
End If
Select Case pNodeConnectSt->dwNodeType
Case WsAB_Cnst_Node_Element
pszValue = NULL
pszThisNodeName = pNodeConnectSt->pszItem
pszNodeType_Ws = WsAB_XmlNode_NodeType_Elem
Case WsAB_Cnst_Node_Attribute
pszValue = NULL
pszThisNodeName = pNodeConnectSt->pszItem
pszNodeType_Ws = WsAB_XmlNode_NodeTyep_Attr
Case WsAB_Cnst_Node_Text
pszValue = pNodeConnectSt->pszItem
pszThisNodeName = WsAB_XmlNode_NodeType_Text
pszNodeType_Ws = WsAB_XmlNode_NodeType_Text
End Select
End If
End Sub
'ノード構造体のルートのポインタを取得する。
Function GetRootNodeSt( pCurr As *Ws_XmlDoc_St_Node ) As *Ws_XmlDoc_St_Node
If NULL=pNodeRootSt Then
If NULL=pCurr->pNodeParent Then
GetRootNodeSt = pCurr
pNodeRootSt = pCurr
Else
GetRootNodeSt = GetRootNodeSt( pCurr->pNodeParent )
End If
Else
GetRootNodeSt = pNodeRootSt
End If
End Function
Private
hXmlNodeHeap As HANDLE
fXmlNodeHeap As Char
pNodeConnectSt As *Ws_XmlDoc_St_Node
pNodeRootSt As *Ws_XmlDoc_St_Node
pszInnerText As BytePtr
pszThisNodeName As BytePtr
pszValue As BytePtr
pszNodeType_Ws As BytePtr
'ノード構造体を複製する
'【要コメント追加】
Function CloneNodeSt( hHeapSrc As HANDLE, pobjNodeStSrc As Ws_XmlDoc_St_Node_Ptr, pobjNodeStNewParent As Ws_XmlDoc_St_Node_Ptr ) As Ws_XmlDoc_St_Node_Ptr
Dim pobjNodeStCurr As Ws_XmlDoc_St_Node_Ptr
Dim pobjNodeStChild As Ws_XmlDoc_St_Node_Ptr
Dim pobjNodeStNext As Ws_XmlDoc_St_Node_Ptr
Dim n As Long
pobjNodeStCurr = HeapAlloc( hHeapSrc, HEAP_ZERO_MEMORY, SizeOf(Ws_XmlDoc_St_Node) ) As Ws_XmlDoc_St_Node_Ptr
n = lstrlen( pobjNodeStSrc->pszItem )
pobjNodeStCurr->pszItem = HeapAlloc( hHeapSrc, HEAP_ZERO_MEMORY, (n+1)*SizeOf(Byte) ) As BytePtr
lstrcpy( pobjNodeStCurr->pszItem, pobjNodeStSrc->pszItem )
pobjNodeStCurr->dwNodeType = pobjNodeStSrc->dwNodeType
pobjNodeStCurr->pNodePrev = NULL
pobjNodeStChild = pobjNodeStSrc->pNodeChild
If pobjNodeStChild<>NULL Then
pobjNodeStChild = CloneNodeSt( hHeapSrc, pobjNodeStChild, pobjNodeStCurr )
pobjNodeStChild->pNodeParent = pobjNodeStCurr
End If
pobjNodeStCurr->pNodeChild = pobjNodeStChild
If NULL<>pobjNodeStNewParent Then
pobjNodeStNext = pobjNodeStSrc->pNodeNext
If pobjNodeStNext<>NULL Then
pobjNodeStNext = CloneNodeSt( hHeapSrc, pobjNodeStNext, pobjNodeStNewParent )
pobjNodeStNext->pNodePrev = pobjNodeStCurr
pobjNodeStNext->pNodeParent = pobjNodeStNewParent
End If
pobjNodeStCurr->pNodeNext = pobjNodeStNext
Else
pobjNodeStCurr->pNodeNext = NULL
End If
pobjNodeStCurr->pXmlNode = New WsAB_XmlNode( hHeapSrc, pobjNodeStCurr )
CloneNodeSt = pobjNodeStCurr
End Function
'これがサポートするXPathは
'"[~]"は添え字と"text()='~'"のみサポート。
'"@"も一応サポート、のはず・・・。
'"./hoge[text()='target']/var"はサポートするが、
'"./hoge[var/text()='innder']/var"はサポート外なので注意。
'"../"は一階層上がるXPathとしてサポート。
'"../../"という繰り返しや"./hoge/"というタグ指定なし型はサポート外なので注意。
'【要コメント追加】
Function SelectSingleNode_Parts( pszXPath As BytePtr ) As WsAB_XmlNodePtr
Dim strXPath As String
Dim nSlash As Long
Dim ppszNodeTknArry As *BytePtr
Dim pnNodeListArry As *Long
Dim ppNdSrhArry As *Ws_XmlDoc_St_Node_Ptr
Dim pnNodeTypeArry As *Long
Dim ppszNodeCndtArry As *BytePtr
Dim pnNodeCndtTypeArry As *Long
Dim nXPath As Long
Dim fMatch As Char
Dim pMark As BytePtr
Dim pIn As BytePtr
Dim pOut As BytePtr
Dim pOutPrv As BytePtr
Dim fNullOut As Char
Dim nNodeType As Long
Dim strElem As String
Dim pNdCurr As *Ws_XmlDoc_St_Node
Dim pNdEq As *Ws_XmlDoc_St_Node
Dim nLen As Long
Dim i As Long
'前準備。
SelectSingleNode_Parts = NULL
strXPath = MakeStr( pszXPath )
pMark = StrPtr( strXPath )
'まずはXPATHを分割する。
'[/]の個数を数える。
nSlash = 0
While pMark[0]<>NULL
If pMark[0]=47 Then
nSlash += 1
End If
pMark++
Wend
'分割格納用の配列を作成して入れる。
ppNdSrhArry = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nSlash+2)*SizeOf(Ws_XmlDoc_St_Node_Ptr) ) As *Ws_XmlDoc_St_Node_Ptr
pnNodeListArry = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nSlash+2)*SizeOf(Long) ) As *Long
ppszNodeTknArry = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nSlash+2)*SizeOf(BytePtr) ) As *BytePtr
pnNodeTypeArry = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nSlash+2)*SizeOf(Long) ) As *Long
ppszNodeCndtArry = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nSlash+2)*SizeOf(BytePtr) ) As *BytePtr
pnNodeCndtTypeArry = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nSlash+2)*SizeOf(Long) ) As *Long
i = 0
pMark = StrPtr( strXPath )
pIn = pMark
pOut = NULL
nNodeType = WsAB_Cnst_Node_Element
While TRUE
Select Case pMark[0]
Case 47, NULL '=[/], Null-Out
fNullOut = 1 and ( pMark[0]=NULL )
pOut = pMark
pOut[0] = NULL
If pOut=pIn Then
strElem = "/"
Else
strElem = MakeStr( pIn )
End If
pnNodeListArry[ i ] = 0 '※配列指定無しを意味する。XPathの配列指定は「1」から始まることに注意
pIn = lstrchr_Xml( StrPtr(strElem), 91 ) '="["
If pIn<>NULL Then
pOut = lstrchr_Xml( pIn, 93 ) '="]"
pOutPrv = lstrchr_Xml( pIn, 39 ) '="'"
'こんなヤツへの対策⇒「 elem[ text()='hoge[fuga]dmy'] 」
If pOutPrv<>NULL Then
pOutPrv = lstrchr_Xml( pOutPrv+1, 39 ) '="'"
End If
While pOut<>NULL and pOut<pOutPrv
pOut = lstrchr_Xml( pOutPrv+1, 93 ) '="]"
Wend
If pOut<>NULL Then
pIn[0] = NULL
pOut[0] = NULL
If NULL<>lstrstr_Xml( pIn+1, "text()" ) Then
pIn = lstrstr_Xml( pIn+1, "text()" )
pIn = lstrstr_Xml( pIn, "'" )
If pIn<>NULL Then
pOut = lstrstr_Xml( pIn+1, "'" )
If pOut<>NULL Then
pIn[0] = NULL
pOut[0] = NULL
nLen = lstrlen( pIn+1 )
ppszNodeCndtArry[ i ] = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nLen+1)*SizeOf(BytePtr) ) As BytePtr
lstrcpy( ppszNodeCndtArry[ i ], pIn+1 )
'※現時点では意味を持たない。
pnNodeCndtTypeArry[ i ] = FALSE
Else
pnNodeListArry[ i ] = 0 '※配列指定無しを意味する。XPathの配列指定は「1」から始まることに注意
End If
Else
pnNodeListArry[ i ] = 0 '※配列指定無しを意味する。XPathの配列指定は「1」から始まることに注意
End If
Else
pnNodeListArry[ i ] = Val( pIn+1 )
End If
'"[~]"を外したものを要素として再設定。
strElem = StrPtr( strElem )
End If
End If
nLen = Len( strElem )
ppszNodeTknArry[ i ] = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nLen+1)*SizeOf(BytePtr) ) As BytePtr
lstrcpy( ppszNodeTknArry[ i ], StrPtr( strElem ) )
pnNodeTypeArry[ i ] = nNodeType
strElem = ""
If fNullOut Then
Exit While
End If
pIn = pMark + 1
pOut = NULL
i++
nNodeType = WsAB_Cnst_Node_Element '次の検索ノードのタイプの初期値を設定。
Case 64 '=[@]
nNodeType = WsAB_Cnst_Node_Attribute
pIn++
Case 91 '="["
pOut = lstrchr_Xml( pMark+1, 93 ) '="]"
If pOut<>NULL Then
pMark = pOut
pOut = NULL
End If
Case Else
End Select
pMark++
Wend
ppszNodeTknArry[ i+1 ] = NULL
'※現状「/*」は扱えないので、「../*」も不可。
' しかし「../*」に限り先行対応するため、ここで処理する。
If i=1 Then
If 0=lstrcmp( ppszNodeTknArry[ 0 ], ".." ) and 0=lstrcmp( ppszNodeTknArry[ 1 ], "/" ) Then
HeapFree( hXmlNodeHeap, 0, ppszNodeTknArry[ 1 ] )
ppszNodeTknArry[ 1 ] = NULL
End If
End If
'検索する。
nXPath = 0
If 0=lstrcmp( ppszNodeTknArry[ 0 ], "/" ) Then
ppNdSrhArry[ nXPath ] = NULL
ppNdSrhArry[ nXPath+1 ] = GetRootNodeSt( pNodeConnectSt )
Else If 0=lstrcmp( ppszNodeTknArry[ 0 ], "." ) Then
ppNdSrhArry[ nXPath ] = pNodeConnectSt
ppNdSrhArry[ nXPath+1 ] = pNodeConnectSt->pNodeChild
Else If 0=lstrcmp( ppszNodeTknArry[ 0 ], ".." ) Then
ppNdSrhArry[ nXPath ] = pNodeConnectSt->pNodeParent
ppNdSrhArry[ nXPath+1 ] = pNodeConnectSt
Else
'※コレはありえない:"./"の正規化を上でやっておこう。
End If
nXPath++
If ppszNodeTknArry[ nXPath ]=NULL Then
pNdEq = ppNdSrhArry[ nXPath-1 ]
Else
pNdEq = NULL
End If
While ppszNodeTknArry[ nXPath ]<>NULL
If ppNdSrhArry[ nXPath ]=NULL Then
'検索先のノードが無い:エラー
pNdEq = NULL
Exit While
Else
fMatch = FALSE
While ppNdSrhArry[ nXPath ]<>NULL
pNdCurr = ppNdSrhArry[ nXPath ]
If 0=lstrcmp( ppszNodeTknArry[ nXPath ], pNdCurr->pszItem ) Then
fMatch = TRUE
If ppszNodeCndtArry[ nXPath ]<>NULL and NULL<>pNdCurr->pNodeChild Then
If 0=lstrcmp( ppszNodeCndtArry[ nXPath ], pNdCurr->pNodeChild->pszItem ) Then
Exit While
Else
ppNdSrhArry[ nXPath ] = pNdCurr->pNodeNext
fMatch = FALSE
End If
Else If pnNodeListArry[ nXPath ]=0 Then
Exit While
Else If pnNodeListArry[ nXPath ]=1 Then
Exit While
Else
pnNodeListArry[ nXPath ] -= 1
ppNdSrhArry[ nXPath ] = pNdCurr->pNodeNext
fMatch = FALSE
End If
Else
ppNdSrhArry[ nXPath ] = pNdCurr->pNodeNext
End If
Wend
If pnNodeTypeArry[ nXPath ] <> pNdCurr->dwNodeType Then
fMatch = FALSE
End If
If fMatch Then
pNdEq = ppNdSrhArry[ nXPath ]
ppNdSrhArry[ nXPath+1 ] = pNdCurr->pNodeChild
nXPath++
Else
pNdEq = NULL
pNdCurr = ppNdSrhArry[ nXPath-1 ]
If pNdCurr=NULL Then
Exit While
End If
ppNdSrhArry[ nXPath-1 ] = pNdCurr->pNodeNext
nXPath--
End If
If nXPath=<1 Then
'検索終了:見つからず。
pNdEq = NULL
Exit While
End If
End If
Wend
If pNdEq<>NULL Then
SelectSingleNode_Parts = pNdEq->pXmlNode
Else
SelectSingleNode_Parts = NULL
End If
'使った配列を開放する。
i = 0
While i<nSlash
HeapFree( hXmlNodeHeap, 0, ppszNodeTknArry[ i ] )
HeapFree( hXmlNodeHeap, 0, ppszNodeCndtArry[ i ] )
i++
Wend
HeapFree( hXmlNodeHeap, 0, ppszNodeTknArry )
HeapFree( hXmlNodeHeap, 0, pnNodeListArry )
HeapFree( hXmlNodeHeap, 0, ppNdSrhArry )
HeapFree( hXmlNodeHeap, 0, pnNodeTypeArry )
HeapFree( hXmlNodeHeap, 0, ppszNodeCndtArry )
HeapFree( hXmlNodeHeap, 0, pnNodeCndtTypeArry )
End Function
End Class
'ABフォーラムへの投稿の都合上、ここで別途定義。。。
'古いライブラリなので#ifndefし忘れてた。。。
Declare Function lstrchr_Xml Lib "shlwapi" Alias "StrChrIA" _
( pBuffer1 As BytePtr, _
bSearch2 As Byte ) As BytePtr
Declare Function lstrstr_Xml Lib "shlwapi" Alias "StrStrIA" _
( pBuffer1 As BytePtr, _
pBuffer2 As BytePtr ) As BytePtr
#endif
3.サンプル
3.1.追加ライブラリ不要版
※上記のクラス本体の定義は略してます。
※長いのでここをクリック [ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード:
Dim objXmlDoc As WsAB_XmlDocument
Dim pobjXmlNode As WsAB_XmlNodePtr
Dim pobjXmlNode_Elem As WsAB_XmlNodePtr
Dim pobjXmlNode_Text As WsAB_XmlNodePtr
Dim s As String
'サンプル:XMLをテキストで設定して、XMLファイルへ出力する。
s = "<root><config><test>aaaa</test><test>bbbb</test></config>"
s = s + "<config><test>hoge</test></config></root>"
objXmlDoc.LoadXml( s )
objXmlDoc.Save( "dbg_0base.xml" )
'サンプル:XPathでノードを選択して、テキスト内容を書き換える。
' その後XMLファイルへ出力する。
s = "/root/config/test"
pobjXmlNode = objXmlDoc.SelectSingleNode( s )
Msgbox 0, pobjXmlNode->FirstChild->Value(), "1st: "+s
pobjXmlNode->FirstChild->Value( "change" )
objXmlDoc.Save( "dbg_1st.xml" )
'サンプル:XPathでノードをテキスト判定つきで選択する。
s = "/root/config/test[ text()='hoge' ]"
pobjXmlNode = objXmlDoc.SelectSingleNode( s )
Msgbox 0, pobjXmlNode->FirstChild->Value(), "2st: "+s
'サンプル:選択したノードの一つ上の階層を選択する。
' ⇒それを親として新規ノードを追加して、XMLファイルへ出力する。
s = "../"
pobjXmlNode = pobjXmlNode->SelectSingleNode( s )
pobjXmlNode_Elem = objXmlDoc.CreateElement( "add_node" )
pobjXmlNode_Text = objXmlDoc.CreateTextNode( "追加したノード" )
pobjXmlNode_Elem->AppendChild( pobjXmlNode_Text )
pobjXmlNode->AppendChild( pobjXmlNode_Elem )
objXmlDoc.Save( "dbg_2nd.xml" )
'サンプル:XPathでノードを配列的に選択して、エレメント名を変更する。
' その後XMLファイルへ出力する。
s = "/root/config[2]"
pobjXmlNode = objXmlDoc.SelectSingleNode( s )
Msgbox 0, pobjXmlNode->Name(), "3rd: "+s
pobjXmlNode->Name( "variable" )
objXmlDoc.Save( "dbg_3rd.xml" )
End
/* ----------------------------------------------------------------
WSLib7_FileRW.sbp
ファイルへの読み書きを簡単に扱うクラスWsFileReadWrite。
CreateFile()、ReadFile()の引数をいちいち定義するのが面倒で、
その回避と自動バッファ確保を目的としている。
※テキストに限らず扱えます。
作成:淡幻星
---------------------------------------------------------------- */
#ifndef _FILE_RW_
#define _FILE_RW_
Class WsFileReadWrite
pReadSource As BytePtr 'ファイル読み取りバッファ
pWriteSource As BytePtr 'ファイル書き込みバッファ
nByteWrite As DWord '書き込むバイト数。
nBytesRead As DWord '読み込んだバイト数
hHeap As DWord
fContentsTF As Long
fOutBufferTF As Long
hFileWrite As HANDLE 'ファイルハンドル(書き込み時にのみ利用してます)。
Public
'コンストラクタ
Sub WsFileReadWrite()
hHeap = HeapCreate( NULL, NULL, NULL )
fContentsTF = FALSE
fOutBufferTF = FALSE
hFileWrite = NULL
End Sub
'デストラクタ
Sub ~WsFileReadWrite()
If( hFileWrite<>NULL )Then
CloseHandle( hFileWrite )
hFileWrite = NULL
End If
HeapDestroy( hHeap )
End Sub
'ファイルを読み込む@全部。
Function OpenFile( pTargetFile As BytePtr ) As Long
OpenFile = OpenFileEx( pTargetFile, 0 )
EndFunction
'ファイルを読み込む@任意のサイズで。dwReadByte=0にすると、すべて読み込む。
Function OpenFileEx( pTargetFile As BytePtr, dwReadByte As DWord ) As Long
Dim retAns As Long
Dim hFile As DWord
Dim nSize As DWord
'ターゲットファイルをオープン
hFile = CreateFile( pTargetFile,
GENERIC_READ,
0,
ByVal NULL,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
NULL )
If( hFile=INVALID_HANDLE_VALUE )Then
OpenFileEx = FALSE
ExitFunction
EndIf
'読み込むサイズの指定。
If( dwReadByte=0 )Then
'ファイルサイズを得る。
nSize = GetFileSize( hFile, 0 )
Else
nSize = dwReadByte
EndIf
'読み取りバッファの確保
If( fContentsTF=FALSE )Then
pReadSource = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nSize + 4*2 )
Else
retAns = HeapFree( hHeap, NULL, pReadSource )
pReadSource = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nSize + 4*2 )
EndIf
'ファイルを全てバッファに読み込む。
retAns = ReadFile( hFile, _
pReadSource, _
nSize, _
VarPtr( nBytesRead ), _
ByVal NULL )
'読み取りが終了したのでファイルをクローズ
retAns = CloseHandle( hFile )
fContentsTF = TRUE
OpenFileEx = TRUE
EndFunction
'読み込みバッファを開放
Function CloseFile() As Long
Dim retAns As Long
retAns = HeapFree( hHeap, NULL, pReadSource )
fContentsTF = FALSE
EndFunction
'読み込んだバイト数を得る
Function WhatByte() As Long
Dim retAns As Long
If( fContentsTF=FALSE )Then
WhatByte = NULL
Else
WhatByte = nBytesRead
EndIf
EndFunction
'読み込んだ内容を得る。
Function GetContents() As BytePtr
If( fContentsTF=FALSE )Then
GetContents = NULL
Else
GetContents = pReadSource
EndIf
EndFunction
'読み込んだ内容をコピーする
'※TEXTかそうでないかに関わらず、コピーを行う。
Function CpyContents( pTargetBuf As VoidPtr ) As Long
Dim pMark As Long
If( fContentsTF=FALSE )Then
CpyContents = FALSE
Else
memcpy( pTargetBuf, pReadSource, nBytesRead )
CpyContents = TRUE
EndIf
EndFunction
'書き込む内容をセットする@TEXTに特化
Function SetContentsTEXT( pBuffer As BytePtr ) As Long
Dim nSize As DWord
Dim pMark As BytePtr
Dim retAns As Long
nSize = lstrlen( pBuffer ) + 1
If( fOutBufferTF=FALSE )Then
pWriteSource = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nSize )
Else
retAns = HeapFree( hHeap, NULL, pWriteSource )
pWriteSource = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nSize )
EndIf
pMark = lstrcpy( pWriteSource, pBuffer )
If( pMark=NULL )Then
SetContentsTEXT = FALSE
Else
SetContentsTEXT = TRUE
nByteWrite = nSize - 1
EndIf
fOutBufferTF = TRUE
EndFunction
'書き込む内容をセットする@汎用
Function SetContents( pBuffer As VoidPtr, nSize As Long ) As Long
Dim retAns As Long
If( fOutBufferTF=FALSE )Then
pWriteSource = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nSize )
Else
retAns = HeapFree( hHeap, NULL, pWriteSource )
pWriteSource = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nSize )
EndIf
If( pWriteSource=NULL )Then
SetContents = FALSE
ExitFunction
Else
SetContents = TRUE
EndIf
memcpy( pWriteSource, pBuffer, nSize )
nByteWrite = nSize
fOutBufferTF = TRUE
EndFunction
'セットされた内容を書き込む@ワンス
Function WriteContents( pTargetFile As BytePtr ) As Long
If( fOutBufferTF=FALSE )Then
WriteContents = FALSE
Else
If( TRUE=WriteContents_Open( pTargetFile ) )Then
WriteContents = WriteContents_Packet( pWriteSource, nByteWrite )
HeapFree( hHeap, NULL, pWriteSource )
nByteWrite = 0
fOutBufferTF = FALSE
WriteContents_Close()
Else
WriteContents = FALSE
End If
EndIf
End Function
'セットされた内容を書き込む@パケット
Function WriteContents_Open( pTargetFile As BytePtr ) As Long
Dim retAns As Long
Dim dwLastAttributes As DWord
'ファイルが既に存在しているなら、属性を保持。
dwLastAttributes = GetFileAttributes( pTargetFile )
If( dwLastAttributes=&HFFFFFFFF )Then
dwLastAttributes = FILE_ATTRIBUTE_NORMAL
End If
'書き込み先を上書きオープン
hFileWrite = CreateFile( pTargetFile,
GENERIC_WRITE,
0,
ByVal NULL,
CREATE_ALWAYS,
dwLastAttributes,
NULL )
If( hFileWrite=INVALID_HANDLE_VALUE )Then
hFileWrite = NULL
WriteContents_Open = FALSE
Else
WriteContents_Open = TRUE
EndIf
End Function
Function WriteContents_Packet( pBuf As BytePtr, nLength As Long ) As Long
Dim nSize As DWord
Dim nBytesWrite As DWord
If( hFileWrite=NULL )Then
WriteContents_Packet = 0
ExitFunction
End If
'バッファのデータをファイルに書き込む。
WriteContents_Packet = WriteFile( hFileWrite,
pBuf,
nLength,
VarPtr( nBytesRead ),
ByVal NULL )
EndFunction
Sub WriteContents_Close()
'書き込みが終了したのでファイルのクローズ
If( hFileWrite<>NULL )Then
CloseHandle( hFileWrite )
hFileWrite = NULL
End If
End Sub
End Class
#endif
3.2.AB淡幻ライブラリ利用版
※上記のクラス本体の定義は略してます。
コード:
#include <WSLib7_AB_Distrbution.sbp>
Dim objXmlDoc As WsAB_XmlDocument
Dim pobjXmlNode As WsAB_XmlNodePtr
Dim pobjXmlNode_Elem As WsAB_XmlNodePtr
Dim pobjXmlNode_Text As WsAB_XmlNodePtr
Dim s As String
'サンプル:XMLをテキストで設定して、XMLファイルへ出力する。
s = "<root><config><test>aaaa</test><test>bbbb</test></config>"
s = s + "<config><test>hoge</test></config></root>"
objXmlDoc.LoadXml( s )
objXmlDoc.Save( "dbg_0base.xml" )
'サンプル:XPathでノードを選択して、テキスト内容を書き換える。
' その後XMLファイルへ出力する。
s = "/root/config/test"
pobjXmlNode = objXmlDoc.SelectSingleNode( s )
Msgbox 0, pobjXmlNode->FirstChild->Value(), "1st: "+s
pobjXmlNode->FirstChild->Value( "change" )
objXmlDoc.Save( "dbg_1st.xml" )
'サンプル:XPathでノードをテキスト判定つきで選択する。
s = "/root/config/test[ text()='hoge' ]"
pobjXmlNode = objXmlDoc.SelectSingleNode( s )
Msgbox 0, pobjXmlNode->FirstChild->Value(), "2st: "+s
'サンプル:選択したノードの一つ上の階層を選択する。
' ⇒それを親として新規ノードを追加して、XMLファイルへ出力する。
s = "../"
pobjXmlNode = pobjXmlNode->SelectSingleNode( s )
pobjXmlNode_Elem = objXmlDoc.CreateElement( "add_node" )
pobjXmlNode_Text = objXmlDoc.CreateTextNode( "追加したノード" )
pobjXmlNode_Elem->AppendChild( pobjXmlNode_Text )
pobjXmlNode->AppendChild( pobjXmlNode_Elem )
objXmlDoc.Save( "dbg_2nd.xml" )
'サンプル:XPathでノードを配列的に選択して、エレメント名を変更する。
' その後XMLファイルへ出力する。
s = "/root/config[2]"
pobjXmlNode = objXmlDoc.SelectSingleNode( s )
Msgbox 0, pobjXmlNode->Name(), "3rd: "+s
pobjXmlNode->Name( "variable" )
objXmlDoc.Save( "dbg_3rd.xml" )
End
4.動作確認環境
ActiveBasic: 4.24.00
OS: Windows XP SP3
以上ー。
2009.11.08
存在しないXPathに対して、最後に存在した上位ノードを返すバグ(本来はNULL応答が正しい)を修正
2009.11.29
ノード削除メソッドにバグ(終端のノードを削除時に前後接続が不正になる)があったので修正。
2011.10.15
偶にアプリケーションエラーで落ちるバグを修正(null終端の直後のアドレスへの違反アクセスが発生することがあった)。
2011.11.25
コメント内部に「<」があると(=javascriptとか)ノードを取得できないバグを修正。
P.S. コメントがあちこち抜けてますが、気力があればそのうち追記します。。。
P.S. x2 一応、InsertAfter()、InsertBefore()、InnerText()、
SelectSingleNode()でのContains()サポートあたりは追加したいと思ってますが、、、
これも気力があればm(_ _)m
P.S. x3 大元のMSXMLの呼び出すパターンの投稿は大歓迎です♪
# コミュニティ復活おめでとうございます。
# ・・・しかし動作が重いっすねぇ。。。(^^;)
XMLを扱う場合は、MSXMLのXmlDocument あたりを 利用することが多いと思います。
[b]しかし[/b]。 AB上からは、これら(COM?)の呼び方がイマイチ分からない/複雑。┐(-ε-)┌ というわけで、同じI/FのクラスをAB用に作成してみました。
XPathを使う必要性に迫られたので、その辺を中心に。 極力同じメソッド名&操作性にしているので、他の言語(VC++,VB,C#等)で 本来のMSXMLを利用する際も混乱しないと思います。
# あ、特殊記号「&'<>'」は内部で勝手にエンティティと変換します。 # なので、クラス越しにXMLを読み書きする際は、そのまま直に記号を扱えます。 # そこは本家MSXML利用より便利かも?
(※当方が必要とするメソッド/メンバしか実装/定義してませんのでアシカラズ)。
[b]1.作成クラスの概要[/b] [hide=■WsAB_XmlNodeクラス] ⇒a)[url=http://msdn.microsoft.com/ja-jp/library/system.xml.xmlnode.aspx]XmlNodeクラス[/url]相当。 b)追加のライブラリは不要。 c)基底クラス:無し d)メソッド: Function SelectSingleNode( pszXPath As BytePtr ) As *WsAB_XmlNode Function RemoveChild( pobjOldChild As WsAB_XmlNodePtr ) As Char Function AppendChild( pobjNewChild As WsAB_XmlNodePtr ) As *WsAB_XmlNode Function Name() As BytePtr Function Name( pszNewName As BytePtr ) As BytePtr Function Value() As BytePtr Function Value( pszNewValue As BytePtr ) As BytePtr e)メソッド: FirstChild As *WsAB_XmlNode [/hide] [hide=■WsAB_XmlDocument_NoAddLibクラス] ⇒a)[url=http://msdn.microsoft.com/ja-jp/library/system.xml.xmldocument.aspx]XmlDocumentクラス[/url]相当。 b)追加のライブラリは不要。 c)基底クラス:WsAB_XmlNodeクラス d)メソッド: Function LoadXml( pszXmlText As BytePtr ) As Char e)メソッド:無し [/hide] [hide=■WsAB_XmlDocumentクラス] ⇒a)[url=http://msdn.microsoft.com/ja-jp/library/system.xml.xmldocument.aspx]XmlDocumentクラス[/url]相当。 ※上記WsAB_XmlDocument_NoAddLibクラスの機能拡張版 b)追加のライブラリとして、[url=http://www.activebasic.com/forum/viewtopic.php?t=2064]AB淡幻ライブラリ[/url]が必要。 ※追加ライブラリを入れたく無い場合は、 利用クラスのソースコードのみ追加したサンプルを 別途掲載してますので、そっちを使ってもらえればOKです。 c)基底クラス:WsAB_XmlDocument_NoAddLibクラス d)メソッド: Function Load( pszFilePath As BytePtr ) As Char Function Save( pszFilePath As BytePtr ) As Char e)メソッド:無し [/hide]
[b]2.クラスの定義(コード)[/b] [hide=※長いのでここをクリック][code] /* [WSLib7_XmlDoc.sbp]
【WSLib7.sbpが必須】 WsAB_XmlDocument・・・XmlDocumentクラスオブジェクト --> 基底クラス:XmlNodeクラス WsAB_XmlDocument_NoAddLibクラス --> メソッド: Function Load( pszFilePath As BytePtr ) As Char --> '成功時はTRUE、失敗するとFALSE。 '※文字コードはShift-JISのみサポート。 Function Save( pszFilePath As BytePtr ) As Char --> '成功時はTRUE、失敗するとFALSE。 '※文字コードはShift-JISのみサポート。
【追加Libは不要】 WsAB_XmlNodePtr ・・・XmlNodeクラスポインタ --> 基底クラス:無し --> メソッド: Function SelectSingleNode( pszXPath As BytePtr ) As WsAB_XmlNodePtr --> XPathは "/", "./", "../" の何れかで始まるもののみサポート。 "[~]"は添え字と"text()='~'"のみサポート。Contains()は【未サポート】。 "@"も一応サポート、のはず・・・。 "./hoge[text()='target']/var"はサポートするが、 "./hoge[var/text()='innder']/var"は【未サポート】なので注意。 "../"は一階層上がるXPathとしてサポート。 "../../"という繰り返しや"./hoge/"というタグ名指定無し型は【未サポート】なので注意。 Function RemoveChild( pobjOldChild As WsAB_XmlNodePtr ) As Char Function AppendChild( pobjNewChild As WsAB_XmlNodePtr ) As WsAB_XmlNodePtr
Function Name() As BytePtr Function Name( pszNewName As BytePtr ) As BytePtr Function Value() As BytePtr Function Value( pszNewValue As BytePtr ) As BytePtr --> プロパティ(メンバ): FirstChild As *WsAB_XmlNode
WsAB_XmlDocument_NoAddLib ・・・XmlDocumentクラスオブジェクトのベース。 --> 基底クラス:XmlNodeクラス --> メソッド: Function LoadXml( pszXmlText As BytePtr ) As Char --> '成功時はTRUE、失敗するとFALSE。 '※文字コードはShift-JISのみサポート。
*/
#ifndef XML_DOC #define XML_DOC
Class WsAB_XmlDocument Inherits WsAB_XmlDocument_NoAddLib
Public Sub WsAB_XmlDocument() 'hDocHeap : 基底クラス WsAB_XmlDocument_NoAddLib のヒープハンドル。 End Sub Sub ~WsAB_XmlDocument() End Sub
Function Load( pszFilePath As BytePtr ) As Char Dim objFile As WsFileReadWrite
Load = objFile.OpenFile( pszFilePath ) If Load Then Load = This.LoadXml( objFile.GetContents() ) End If End Function Function Save( pszFilePath As BytePtr ) As Char Dim objFile As WsFileReadWrite Dim strLcl_ProcessingInstruction_Version As String Dim strBuf As String
strLcl_ProcessingInstruction_Version = Ex"<?xml version=\q1.0\q encoding=\qShift_JIS\q?>"
Save = objFile.WriteContents_Open( pszFilePath ) strBuf = strLcl_ProcessingInstruction_Version + Ex"\r\n" objFile.WriteContents_Packet( strBuf, Len(strBuf) )
Save_Parts( pThisRootNode, 0, TRUE, VarPtr(objFile) ) objFile.WriteContents_Close() End Function
Private Function Save_Parts( pCurr As *Ws_XmlDoc_St_Node, nTabIndent As Long, fTagColsed As BytePtr, pobjOutFile As *WsFileReadWrite ) As Char Dim pParent As *Ws_XmlDoc_St_Node Dim pPrev As *Ws_XmlDoc_St_Node Dim pChild As *Ws_XmlDoc_St_Node Dim fLastChildText As Char Dim strBuf As String Dim pIn As BytePtr Dim pOut As BytePtr
If pCurr<>NULL Then Select Case pCurr->dwNodeType Case WsAB_Cnst_Node_Element If fTagColsed=FALSE Then strBuf = Ex">\r\n" pobjOutFile->WriteContents_Packet( strBuf, Len(strBuf) ) fTagColsed = TRUE End If
If NULL<>pCurr->pNodeChild Then strBuf = String$( nTabIndent*2, " " ) + "<" + MakeStr( pCurr->pszItem ) pobjOutFile->WriteContents_Packet( strBuf, Len(strBuf) )
fLastChildText = Save_Parts( pCurr->pNodeChild, nTabIndent + 1, FALSE, pobjOutFile )
If fLastChildText Then strBuf = "</" + MakeStr( pCurr->pszItem ) + Ex">\r\n" Else strBuf = String$( nTabIndent*2, " " ) + "</" + MakeStr( pCurr->pszItem ) + Ex">\r\n" End If pobjOutFile->WriteContents_Packet( strBuf, Len(strBuf) ) Else strBuf = String$( nTabIndent*2, " " ) + "<" + MakeStr( pCurr->pszItem ) + Ex" />\r\n" pobjOutFile->WriteContents_Packet( strBuf, Len(strBuf) ) End If
fLastChildText = FALSE
Case WsAB_Cnst_Node_Attribute If fTagColsed=FALSE Then strBuf = " " + MakeStr( pCurr->pszItem ) + Ex"=\q" If NULL<>pCurr->pNodeChild Then pChild = pCurr->pNodeChild If NULL<>pChild->pszItem Then strBuf = strBuf + MakeStr( pChild->pszItem ) End If strBuf = strBuf + Ex"\q" pobjOutFile->WriteContents_Packet( strBuf, Len(strBuf) ) End If
fTagColsed = FALSE Else '想定外の呼び出し。 End If
fLastChildText = FALSE
Case WsAB_Cnst_Node_Text If fTagColsed=FALSE Then strBuf = Ex">" pobjOutFile->WriteContents_Packet( strBuf, Len(strBuf) ) fTagColsed = TRUE End If
strBuf = MakeStr( pCurr->pszItem ) pIn = StrPtr( strBuf ) Do pOut = lstrchr_Xml( pIn, 38 ) If pOut<>NULL Then pOut[0] = NULL pobjOutFile->WriteContents_Packet( pIn, lstrlen(pIn) ) pobjOutFile->WriteContents_Packet( "&", 5 ) pIn = pOut + 1 Else pOut = lstrchr_Xml( pIn, 60 ) If pOut<>NULL Then pOut[0] = NULL pobjOutFile->WriteContents_Packet( pIn, lstrlen(pIn) ) pobjOutFile->WriteContents_Packet( "<", 4 ) pIn = pOut + 1 Else pOut = lstrchr_Xml( pIn, 62 ) If pOut<>NULL Then pOut[0] = NULL pobjOutFile->WriteContents_Packet( pIn, lstrlen(pIn) ) pobjOutFile->WriteContents_Packet( ">", 4 ) pIn = pOut + 1 Else pOut = lstrchr_Xml( pIn, 39 ) If pOut<>NULL Then pOut[0] = NULL pobjOutFile->WriteContents_Packet( pIn, lstrlen(pIn) ) pobjOutFile->WriteContents_Packet( """, 6 ) pIn = pOut + 1 Else pOut = lstrchr_Xml( pIn, 34 ) If pOut<>NULL Then pOut[0] = NULL pobjOutFile->WriteContents_Packet( pIn, lstrlen(pIn) ) pobjOutFile->WriteContents_Packet( "'", 6 ) pIn = pOut + 1 Else pobjOutFile->WriteContents_Packet( pIn, lstrlen(pIn) ) Exit Do End If End If End If End If End If Loop fLastChildText = TRUE
Case Else 'No Action:ありえない。
End Select
If NULL<>pCurr->pNodeNext Then fLastChildText = Save_Parts( pCurr->pNodeNext, nTabIndent, fTagColsed, pobjOutFile ) End If End If
Save_Parts = fLastChildText
End Function
End Class
Type Ws_XmlDoc_St_Node dwNodeType As DWord pNodePrev As *Ws_XmlDoc_St_Node pNodeNext As *Ws_XmlDoc_St_Node pNodeChild As *Ws_XmlDoc_St_Node pNodeParent As *Ws_XmlDoc_St_Node pszItem As BytePtr pXmlNode As *WsAB_XmlNode End Type TypeDef Ws_XmlDoc_St_Node_Ptr = *Ws_XmlDoc_St_Node Const WsAB_Cnst_Node_Element = 1 Const WsAB_Cnst_Node_Attribute = 2 Const WsAB_Cnst_Node_Text = 3
Const WsAB_XmlDoc_NodeType_Text = "text" Const WsAB_XmlDoc_NodeType_Elem = "element" Const WsAB_XmlDoc_NodeType_Attr = "attribute" Class WsAB_XmlDocument_NoAddLib Inherits WsAB_XmlNode
Public Sub WsAB_XmlDocument_NoAddLib() WsAB_XmlNode( NULL, NULL )
hDocHeap = HeapCreate( NULL, 0, 0 ) pThisDoc = NULL
pThisCreateNodeRoot = CreateNode_Parts( WsAB_XmlDoc_NodeType_Elem, "crt_root", "" ) pThisCreateNodeLast = pThisCreateNodeRoot
pThisRootNode = NULL End Sub Sub ~WsAB_XmlDocument_NoAddLib() NodeStDel( hDocHeap, pThisCreateNodeRoot )
If pThisRootNode<>NULL Then NodeStDel( hDocHeap, pThisRootNode ) pThisRootNode = NULL End If HeapDestroy( hDocHeap ) End Sub
Function CreateElement( pszElemName As BytePtr ) As WsAB_XmlNodePtr CreateElement = CreateNode( WsAB_XmlDoc_NodeType_Elem, pszElemName, NULL ) End Function Function CreateTextNode( pszText As BytePtr ) As WsAB_XmlNodePtr CreateTextNode = CreateNode( WsAB_XmlDoc_NodeType_Text, pszText, NULL ) End Function Function CreateNode( pszNodeTypeString As BytePtr, pszName As BytePtr, pszNamespaceURI As BytePtr ) As WsAB_XmlNodePtr Dim pCrt As *Ws_XmlDoc_St_Node Dim pobjXmlNode As WsAB_XmlNodePtr
pCrt = CreateNode_Parts( pszNodeTypeString, pszName, "" ) pobjXmlNode = New WsAB_XmlNode( hDocHeap, pCrt )
If pThisCreateNodeLast=pThisCreateNodeRoot Then pThisCreateNodeRoot->pNodeChild = pCrt Else pThisCreateNodeLast->pNodeNext = pCrt pCrt->pNodePrev = pThisCreateNodeLast End If pCrt->pNodeParent = pThisCreateNodeRoot pCrt->pXmlNode = pobjXmlNode
pThisCreateNodeLast = pCrt CreateNode = pobjXmlNode End Function
Function LoadXml( pszXmlText As BytePtr ) As Char Dim pXml_NoBrankOmit As BytePtr
Dim pCurr As *Ws_XmlDoc_St_Node Dim pParent As *Ws_XmlDoc_St_Node Dim pPrev As *Ws_XmlDoc_St_Node
Dim pEnd As BytePtr Dim pMark As BytePtr Dim pTagNameIn As BytePtr Dim pTagNameOut As BytePtr
Dim n As Long Dim b As Byte Dim pszAttrBuf As BytePtr
'【未実装】pThisDoc にXML内容を読み込む。
'空要素を<elem />の形に統一。 '※<elem />は処理できるが、<elem/>は処理できない都合による。 pXml_NoBrankOmit = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, 2*lstrlen( pszXmlText )*SizeOf(Byte) ) As BytePtr ConvertBrankWhSpc( pXml_NoBrankOmit, pszXmlText )
'属性取得用のバッファ確保 pszAttrBuf = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, (lstrlen( pXml_NoBrankOmit )+1)*SizeOf(Byte) ) As BytePtr
'パラメータの初期化(準備)。 pMark = pXml_NoBrankOmit pEnd = pMark + lstrlen( pMark ) If pThisRootNode<>NULL Then NodeStDel( hDocHeap, pThisRootNode ) pThisRootNode = NULL End If pPrev = NULL pCurr = NULL pParent = NULL pTagNameIn = NULL pTagNameOut = NULL LoadXml = FALSE
'ノード構造体へ分解していく。 While pMark =< pEnd Select Case pMark[0] Case 0 '=NULL '正常終了 If pThisRootNode<>NULL Then LoadXml = TRUE Else LoadXml = FALSE End If Exit While
Case 60 '=[<] 'タグの開始を見つけた。 pTagNameIn = pMark + 1
Case 63 '=[?] If 60=GetByte( pMark-1 ) Then '=[<] '※XML宣言とか。開始タグ情報を解除する。 pTagNameIn = NULL End If
Case 33 '=[!] If 0=memcmp( pMark-1, "<!", 2 ) Then '※コメントの処理。開始タグ情報を解除したうえで、コメント終端まで読み飛ばす。 pTagNameIn = NULL pMark = lstrstr_Xml( pMark+1 , "-->" ) End If
Case 47 '=[/] If 62=GetByte( pMark+1 ) Then '=[>] 'タグ終端@空要素だった。 '⇒そのまま親ノードを閉じる。 pPrev = pParent If pParent<>NULL Then pParent = pParent->pNodeParent End If pCurr = NULL pTagNameIn = NULL pTagNameOut = NULL
Else If 60=GetByte( pMark-1 ) Then '=[<] '閉タグの開始を見つけた。 '⇒テキストがあるかをチェックしてから親ノードを閉じる。
'※開始タグとの一致をチェックする If pParent<>NULL Then If pParent->pszItem <> NULL Then If 0<>memcmp( pParent->pszItem, pMark+1, lstrlen(pParent->pszItem) ) Then Exit While End If End If End If
If pTagNameOut<>NULL and pTagNameOut<>pMark-1 Then 'テキストが在るっぽい。 '※上記は空要素でないことも考慮してます。
'テキストの前後の改行、タブ、半角スペースは外す。 pTagNameIn = pTagNameOut pTagNameOut = pMark - 2 While ( pTagNameIn[0]=13 or pTagNameIn[0]=10 or pTagNameIn[0]=9 or pTagNameIn[0]=32 ) and pTagNameIn < pTagNameOut pTagNameIn++ Wend While ( pTagNameOut[0]=13 or pTagNameOut[0]=10 or pTagNameIn[0]=9 or pTagNameIn[0]=32 ) and pTagNameIn < pTagNameOut pTagNameOut-- Wend pTagNameOut++
'ノード@テキストを新規作成&内容格納。 b = pTagNameOut[0] pTagNameOut[0] = NULL pCurr = CreateNode_Parts( WsAB_XmlDoc_NodeType_Text, pTagNameIn, "" ) pTagNameOut[0] = b
'前後のノードに接続。 If pPrev=NULL Then pParent->pNodeChild = pCurr pCurr->pNodePrev = NULL Else pPrev->pNodeNext = pCurr pCurr->pNodePrev = pPrev End If pCurr->pNodeNext = NULL pCurr->pNodeChild = NULL pCurr->pNodeParent = pParent
End If
'親ノードを閉じる。 pPrev = pParent If pParent<>NULL Then pParent = pParent->pNodeParent End If pCurr = NULL pTagNameIn = NULL pTagNameOut = NULL End If
Case 32, 61, 62 '=[ ], [=], [>] '要素名/属性名の終わりっっぽい。 If pTagNameIn<>NULL Then 'ノードを新規に作成して、タグ名を格納。 n = pMark - pTagNameIn b = pMark[0] pMark[0] = NULL pCurr = CreateNode_Parts( WsAB_XmlDoc_NodeType_Elem, pTagNameIn, "" ) pMark[0] = b
'直前の兄弟ノードに接続。 If pPrev<>NULL Then pPrev->pNodeNext = pCurr pCurr->pNodePrev = pPrev pCurr->pNodeParent = pParent '親は必ずつなぐ:直ぐ上に上がれるように。 Else '兄弟が居ない=親。ルートの場合もある。 If pThisRootNode=NULL Then 'ルートとして設定。 pThisRootNode = pCurr pThisRootNode->pNodePrev = NULL pThisRootNode->pNodeNext = NULL pThisRootNode->pNodeParent = NULL Else '親ノードに接続 If pParent->pNodeChild=NULL Then pParent->pNodeChild = pCurr End If pCurr->pNodeParent = pParent pCurr->pNodePrev = NULL End If End If
'作成したノードに対する処理を終える。 pParent = pCurr pCurr = NULL pPrev = NULL
'属性値を考慮 Select Case b Case 32 '属性値が続くかも。 pTagNameIn = pMark + 1 pTagNameOut = NULL
Case 61 '=[=] '今のが属性値だった。 pParent->dwNodeType = WsAB_Cnst_Node_Attribute
'ノード@テキストに内容を格納。 n = GetAttrText( pMark + 2, pszAttrBuf ) pCurr = CreateNode_Parts( WsAB_XmlDoc_NodeType_Attr, pszAttrBuf, "" ) pMark = pMark + 2 + n + 1
'前後のノードを接続 pParent->pNodeChild = pCurr pCurr->pNodeNext = NULL pCurr->pNodePrev = NULL pCurr->pNodeChild = NULL pCurr->pNodeParent = pParent
If pMark[0]=32 Then 'さらに、属性値が続くかも。 pTagNameIn = pMark + 1 pTagNameOut = NULL Else '属性もう無し=タグ名を抜けた。 pTagNameIn = NULL pTagNameOut = lstrchr_Xml( pMark, 62 ) '=[>] ※エラー処理すべき? pTagNameOut = pMark + 1 End If
'属性を閉じる。 pPrev = pParent pParent = pParent->pNodeParent pCurr = NULL
Case Else '属性もう無し=タグ名を抜けた。 pTagNameIn = NULL pTagNameOut = pMark + 1
End Select End If
End Select
pMark++ Wend
'ノード構造体の個々に個々のXmlNodeオブジェクトを関連付ける。 '※ルートについては、こいつと下記の基底クラスとが二つ接続 ' ただし、構造体側から見えるのはこっちだけ。 ConnectBoth_NodeStTree( pThisRootNode )
'規定クラスのXmlNodeへ接続。 '※先に上記のTreeを作成しておくこと。 ConnectStNode( pThisRootNode )
HeapFree( hDocHeap, 0, pszAttrBuf ) HeapFree( hDocHeap, 0, pXml_NoBrankOmit ) End Function
Protected hDocHeap As HANDLE pThisDoc As BytePtr pThisRootNode As *Ws_XmlDoc_St_Node pThisCreateNodeRoot As *Ws_XmlDoc_St_Node pThisCreateNodeLast As *Ws_XmlDoc_St_Node
'※pszNamespaceURIは現時点では無意味。 Function CreateNode_Parts( pszNodeTypeString As BytePtr, pszName As BytePtr, pszNamespaceURI As BytePtr ) As WsAB_XmlNodePtr Dim pobjCurr As *Ws_XmlDoc_St_Node Dim n As Long Dim i As Long Dim j As Long
pobjCurr = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, SizeOf(Ws_XmlDoc_St_Node) ) As Ws_XmlDoc_St_Node_Ptr
If 0=lstrcmp( pszNodeTypeString, WsAB_XmlDoc_NodeType_Elem ) Then n = lstrlen( pszName ) pobjCurr->pszItem = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, (n+1)*SizeOf(Byte) ) As BytePtr lstrcpy( pobjCurr->pszItem, pszName )
pobjCurr->dwNodeType = WsAB_Cnst_Node_Element
Else If 0=lstrcmp( pszNodeTypeString, WsAB_XmlDoc_NodeType_Attr ) Then n = lstrlen( pszName ) pobjCurr->pszItem = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, (n+1)*SizeOf(Byte) ) As BytePtr lstrcpy( pobjCurr->pszItem, pszName )
pobjCurr->dwNodeType = WsAB_Cnst_Node_Attribute
Else If 0=lstrcmp( pszNodeTypeString, WsAB_XmlDoc_NodeType_Text ) Then n = lstrlen( pszName ) If NULL=lstrchr_Xml( pszName, 38 ) Then '=[&] pobjCurr->pszItem = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, (2*n+1)*SizeOf(Byte) ) As BytePtr lstrcpy( pobjCurr->pszItem, pszName ) Else n = n * 2 + 1 pobjCurr->pszItem = HeapAlloc( hDocHeap, HEAP_ZERO_MEMORY, n*SizeOf(Byte) ) As BytePtr i = 0 j = 0 While j<n Select Case pszName[i] Case NULL Exit While
Case 38 '=[&]=[&] If 0=memcmp( pszName+i, "&", 5 ) Then pobjCurr->pszItem[j] = 38 i += 4 Else If 0=memcmp( pszName+i, ">", 4 ) Then pobjCurr->pszItem[j] = 62 i += 3 Else If 0=memcmp( pszName+i, "<", 4 ) Then pobjCurr->pszItem[j] = 60 i += 3 Else If 0=memcmp( pszName+i, """, 6 ) Then pobjCurr->pszItem[j] = 39 i += 3 Else If 0=memcmp( pszName+i, "'", 6 ) Then pobjCurr->pszItem[j] = 34 i += 3 Else pobjCurr->pszItem[j] = pszName[i] End If
Case Else pobjCurr->pszItem[j] = pszName[i]
End Select i++ j++ Wend pobjCurr->pszItem[j] = NULL
End If
pobjCurr->dwNodeType = WsAB_Cnst_Node_Text End If
CreateNode_Parts = pobjCurr End Function
'保持しているノード構造体ツリーに、XmlNodeオブジェクトを関連付ける。 Sub ConnectBoth_NodeStTree( pNodeSt As *Ws_XmlDoc_St_Node ) Dim dwNodeNum As DWord Dim pXmlNode As *WsAB_XmlNode Dim pParent As *Ws_XmlDoc_St_Node Dim pPrev As *Ws_XmlDoc_St_Node
If pNodeSt<>NULL Then If NULL<>pNodeSt->pNodeChild Then ConnectBoth_NodeStTree( pNodeSt->pNodeChild ) End If If NULL<>pNodeSt->pNodeNext Then ConnectBoth_NodeStTree( pNodeSt->pNodeNext ) End If
pXmlNode = New WsAB_XmlNode( hDocHeap, pNodeSt ) pNodeSt->pXmlNode = pXmlNode End If End Sub
'属性の["]で囲まれた内容をString型で得る。 Function GetAttrText( pStart As BytePtr, pszAttrBuf As BytePtr ) As Long Dim p As BytePtr Dim n As Long
p = pStart While p[0]<>NULL and p[0]<>34 '=["] p++ Wend
If p[0]<>NULL Then p[0] = NULL lstrcpy( pszAttrBuf, pStart ) n = lstrlen( pszAttrBuf ) p[0] = 34 pszAttrBuf[n] = NULL GetAttrText = n Else GetAttrText = 0 End If End Function
'空要素の整形<elem /> or <elem/> ⇒ <elem /> ※空白は一つだけ! Sub ConvertBrankWhSpc( pszXmlTextOut As BytePtr, pszXmlTextIn As BytePtr ) Dim pIn As BytePtr Dim pOut As BytePtr Dim pCat As BytePtr
pCat = pszXmlTextOut pIn = pszXmlTextIn pOut = lstrstr_Xml( pIn, "/>" ) While pOut<>NULL pOut[0] = NULL lstrcpy( pCat, pIn ) pCat += lstrlen( pCat ) pOut[0] = 47 '=[/] pIn = pOut + 2
pCat-- While pCat[0]=32 '=[ ] pCat-- Wend pCat++ pCat[0] = NULL
lstrcpy( pCat, " />" ) pCat += lstrlen( pCat )
pOut = lstrstr_Xml( pIn, "/>" ) Wend lstrcpy( pCat, pIn ) End Sub End Class
TypeDef WsAB_XmlNodePtr = *WsAB_XmlNode Const WsAB_XmlNode_NodeType_Text = "#text" Const WsAB_XmlNode_NodeType_Elem = "#element" Const WsAB_XmlNode_NodeTyep_Attr = "#attribute" Const WsAB_XmlNode_SpcialXPath = "getNodeSt()"
Class WsAB_XmlNode Public Sub WsAB_XmlNode( hParentHeap As HANDLE, pstDoc_St_Node As *Ws_XmlDoc_St_Node ) If hParentHeap=NULL Then hXmlNodeHeap = HeapCreate( NULL, 0, 0 ) fXmlNodeHeap = TRUE Else hXmlNodeHeap = hParentHeap fXmlNodeHeap = FALSE End If
'初期化 pNodeConnectSt = pstDoc_St_Node pszInnerText = NULL pszThisNodeName = NULL pszValue = NULL
'各種プロパティに値を設定。 CreatePropatry() End Sub Sub ~WsAB_XmlNode() If fXmlNodeHeap Then HeapDestroy( hXmlNodeHeap ) End If End Sub
Public FirstChild As *WsAB_XmlNode
Function Name() As BytePtr Name = pszThisNodeName End Function Function Name( pszNewName As BytePtr ) As BytePtr If NULL<>This.Name() Then HeapFree( hXmlNodeHeap, 0, pNodeConnectSt->pszItem ) pNodeConnectSt->pszItem = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, 1+lstrlen( pszNewName ) ) As BytePtr pszThisNodeName = pNodeConnectSt->pszItem lstrcpy( pszThisNodeName, pszNewName ) Name = pszThisNodeName Else Name = NULL End If End Function
Function Value() As BytePtr Value = pszValue End Function Function Value( pszNewValue As BytePtr ) As BytePtr If NULL<>This.Value() Then HeapFree( hXmlNodeHeap, 0, pNodeConnectSt->pszItem ) pNodeConnectSt->pszItem = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, 1+lstrlen( pszNewValue ) ) As BytePtr pszValue = pNodeConnectSt->pszItem lstrcpy( pszValue, pszNewValue ) Value = pszValue Else Value = NULL End If End Function
'書き換えは許可しない。 Function NodeType_Ws() As BytePtr NodeType_Ws = pszNodeType_Ws End Function
Function InnerText() As BytePtr '未実装 'pszInnerText = NULL End Function Function InnerText( pszNewText As BytePtr ) As BytePtr '未実装 End Function
Function SelectSingleNode( pszXPath As BytePtr ) As WsAB_XmlNodePtr '※分割することで、何かコーディングしやすい部分が ' 在るかと思ったのだが、、、現時点ではなかった。。。 ' ⇒正規化とかに使えるかな?(./省略形への対応)
If 0=lstrcmp( pszXPath, WsAB_XmlNode_SpcialXPath ) Then '※特殊XPath:内部保持しているノード構造体を返す。 SelectSingleNode = pNodeConnectSt As WsAB_XmlNodePtr Else SelectSingleNode = SelectSingleNode_Parts( pszXPath ) End If End Function
Function RemoveChild( pobjOldChild As WsAB_XmlNodePtr ) As Char If pobjOldChild=VarPtr( This ) Then RemoveChild = NodeStDel( NULL, pNodeConnectSt ) Else RemoveChild = pobjOldChild->RemoveChild( pobjOldChild ) Delete pobjOldChild End If End Function
Function AppendChild( pobjNewChild As WsAB_XmlNodePtr ) As WsAB_XmlNodePtr Dim pobjNodeStLst As Ws_XmlDoc_St_Node_Ptr Dim pobjNodeStSrc As Ws_XmlDoc_St_Node_Ptr Dim pobjNodeStNew As Ws_XmlDoc_St_Node_Ptr
pobjNodeStSrc = pobjNewChild->SelectSingleNode( WsAB_XmlNode_SpcialXPath ) As Ws_XmlDoc_St_Node_Ptr pobjNodeStNew = CloneNodeSt( hXmlNodeHeap, pobjNodeStSrc, NULL )
pobjNodeStLst = pNodeConnectSt->pNodeChild If pobjNodeStLst=NULL Then '子ノードが無い⇒新規に追加。 pNodeConnectSt->pNodeChild = pobjNodeStNew Else '子ノードがある⇒一番末っ子を探してから追加。 While NULL <> pobjNodeStLst->pNodeNext pobjNodeStLst = pobjNodeStLst->pNodeNext Wend pobjNodeStLst->pNodeNext = pobjNodeStNew pobjNodeStNew->pNodePrev = pobjNodeStLst pobjNodeStNew->pNodeNext = NULL End If '自分にとっての親は、常に設定する。 pobjNodeStNew->pNodeParent = pNodeConnectSt
AppendChild = pobjNodeStNew->pXmlNode End Function
#ifdef XML_NODE_DEBUG Function GetRootDebug() As *Ws_XmlDoc_St_Node GetRootDebug = pNodeConnectSt End Function #endif Protected 'ノード構造体の削除 Function NodeStDel( hParentHeap As HANDLE, pstNodeSt As *Ws_XmlDoc_St_Node ) As Char Dim hHeap As HANDLE Dim fCalledByOther As Char Dim pParent As *Ws_XmlDoc_St_Node Dim pPrev As *Ws_XmlDoc_St_Node Dim pNext As *Ws_XmlDoc_St_Node
If pstNodeSt=NULL Then Exit Function End If
If hParentHeap=NULL Then '省略=自分自身のクラスから呼ばれた、フラグとする。 hHeap = hXmlNodeHeap fCalledByOther = FALSE Else '明示される=自分自身以外で呼ばれている、フラグとする。 hHeap = hParentHeap fCalledByOther = TRUE End If
'子供を全部削除 While NULL <> pstNodeSt->pNodeChild '※子供への\削除指示=自分以外を削除、なのでHEAPハンドルを明示する。 NodeStDel( hHeap, pstNodeSt->pNodeChild ) Wend
'保持アイテムを削除 If pstNodeSt->pszItem<>NULL Then HeapFree( hHeap, 0, pstNodeSt->pszItem ) pstNodeSt->pszItem = NULL End If
'前後の兄弟から切り離す。 '※これを、保持アイテム削除のあとにしないと【コンパイラ】がバグる。。。 pPrev = pstNodeSt->pNodePrev pNext = pstNodeSt->pNodeNext If NULL=pPrev Then '前の兄弟が居ない=親から認識されている長男 '⇒自分の次の兄弟を親に接続しなおす。 pParent = pstNodeSt->pNodeParent If pParent<>NULL Then '自分の次の兄弟を親に接続しなおす。 '※自分側の親認識は常にあるので、再設定不要。 pParent->pNodeChild = pNext '↑ここ、Debug実行だと、何故かpstNodeSt自身が書き換わる。。。 ' ⇒つまり、pNext=0だと、pstNodeSt=0 とかふざけたことに。。。
If NULL<>pNext Then '次の兄弟から、自分を切り離す。 pNext->pNodePrev = NULL End If Else '親設定無し=ルート:何もしない。 End If Else '前の兄弟から、自分を切り離す。 pPrev->pNodeNext = pNext
'自分が末っ子でなければ、自分の前後の兄弟をつなぎ、自分を切り離す。 If NULL<>pNext Then pNext->pNodePrev = pPrev End If End If
'関連付けられているXmlNodeオブジェクトを破棄。 If fCalledByOther Then If pstNodeSt->pXmlNode<>NULL Then Delete pstNodeSt->pXmlNode pstNodeSt->pXmlNode = NULL End If End If
'自分自身を削除 '※最後にNULL指定するが、実際は上の兄弟からの切り離しでNULLアウトされるので不要。 NodeStDel = HeapFree( hHeap, 0, pstNodeSt ) pstNodeSt = NULL End Function
'ノード構造体を、本クラスへ関連付ける。 Sub ConnectStNode( pstDoc_St_Node As *Ws_XmlDoc_St_Node ) '対応するノード構造体のポインタを保持。 pNodeConnectSt = pstDoc_St_Node
'各種プロパティに値を設定。 CreatePropatry()
'親ノード構造体は、この時点では不明。 pNodeRootSt = NULL End Sub
'各種プロパティに値を設定。 Sub CreatePropatry() If pNodeConnectSt<>NULL Then If pNodeConnectSt->pNodeChild <>NULL Then FirstChild = pNodeConnectSt->pNodeChild->pXmlNode Else FirstChild = NULL End If
Select Case pNodeConnectSt->dwNodeType Case WsAB_Cnst_Node_Element pszValue = NULL pszThisNodeName = pNodeConnectSt->pszItem pszNodeType_Ws = WsAB_XmlNode_NodeType_Elem
Case WsAB_Cnst_Node_Attribute pszValue = NULL pszThisNodeName = pNodeConnectSt->pszItem pszNodeType_Ws = WsAB_XmlNode_NodeTyep_Attr
Case WsAB_Cnst_Node_Text pszValue = pNodeConnectSt->pszItem pszThisNodeName = WsAB_XmlNode_NodeType_Text pszNodeType_Ws = WsAB_XmlNode_NodeType_Text
End Select
End If End Sub
'ノード構造体のルートのポインタを取得する。 Function GetRootNodeSt( pCurr As *Ws_XmlDoc_St_Node ) As *Ws_XmlDoc_St_Node If NULL=pNodeRootSt Then If NULL=pCurr->pNodeParent Then GetRootNodeSt = pCurr pNodeRootSt = pCurr Else GetRootNodeSt = GetRootNodeSt( pCurr->pNodeParent ) End If Else GetRootNodeSt = pNodeRootSt End If End Function
Private hXmlNodeHeap As HANDLE fXmlNodeHeap As Char
pNodeConnectSt As *Ws_XmlDoc_St_Node pNodeRootSt As *Ws_XmlDoc_St_Node pszInnerText As BytePtr pszThisNodeName As BytePtr pszValue As BytePtr pszNodeType_Ws As BytePtr
'ノード構造体を複製する '【要コメント追加】 Function CloneNodeSt( hHeapSrc As HANDLE, pobjNodeStSrc As Ws_XmlDoc_St_Node_Ptr, pobjNodeStNewParent As Ws_XmlDoc_St_Node_Ptr ) As Ws_XmlDoc_St_Node_Ptr Dim pobjNodeStCurr As Ws_XmlDoc_St_Node_Ptr Dim pobjNodeStChild As Ws_XmlDoc_St_Node_Ptr Dim pobjNodeStNext As Ws_XmlDoc_St_Node_Ptr Dim n As Long
pobjNodeStCurr = HeapAlloc( hHeapSrc, HEAP_ZERO_MEMORY, SizeOf(Ws_XmlDoc_St_Node) ) As Ws_XmlDoc_St_Node_Ptr
n = lstrlen( pobjNodeStSrc->pszItem ) pobjNodeStCurr->pszItem = HeapAlloc( hHeapSrc, HEAP_ZERO_MEMORY, (n+1)*SizeOf(Byte) ) As BytePtr lstrcpy( pobjNodeStCurr->pszItem, pobjNodeStSrc->pszItem )
pobjNodeStCurr->dwNodeType = pobjNodeStSrc->dwNodeType
pobjNodeStCurr->pNodePrev = NULL
pobjNodeStChild = pobjNodeStSrc->pNodeChild If pobjNodeStChild<>NULL Then pobjNodeStChild = CloneNodeSt( hHeapSrc, pobjNodeStChild, pobjNodeStCurr ) pobjNodeStChild->pNodeParent = pobjNodeStCurr End If pobjNodeStCurr->pNodeChild = pobjNodeStChild
If NULL<>pobjNodeStNewParent Then pobjNodeStNext = pobjNodeStSrc->pNodeNext If pobjNodeStNext<>NULL Then pobjNodeStNext = CloneNodeSt( hHeapSrc, pobjNodeStNext, pobjNodeStNewParent ) pobjNodeStNext->pNodePrev = pobjNodeStCurr pobjNodeStNext->pNodeParent = pobjNodeStNewParent End If pobjNodeStCurr->pNodeNext = pobjNodeStNext Else pobjNodeStCurr->pNodeNext = NULL End If
pobjNodeStCurr->pXmlNode = New WsAB_XmlNode( hHeapSrc, pobjNodeStCurr )
CloneNodeSt = pobjNodeStCurr End Function
'これがサポートするXPathは '"[~]"は添え字と"text()='~'"のみサポート。 '"@"も一応サポート、のはず・・・。 '"./hoge[text()='target']/var"はサポートするが、 '"./hoge[var/text()='innder']/var"はサポート外なので注意。 '"../"は一階層上がるXPathとしてサポート。 '"../../"という繰り返しや"./hoge/"というタグ指定なし型はサポート外なので注意。 '【要コメント追加】 Function SelectSingleNode_Parts( pszXPath As BytePtr ) As WsAB_XmlNodePtr Dim strXPath As String Dim nSlash As Long Dim ppszNodeTknArry As *BytePtr Dim pnNodeListArry As *Long Dim ppNdSrhArry As *Ws_XmlDoc_St_Node_Ptr Dim pnNodeTypeArry As *Long Dim ppszNodeCndtArry As *BytePtr Dim pnNodeCndtTypeArry As *Long
Dim nXPath As Long Dim fMatch As Char Dim pMark As BytePtr Dim pIn As BytePtr Dim pOut As BytePtr Dim pOutPrv As BytePtr Dim fNullOut As Char Dim nNodeType As Long Dim strElem As String Dim pNdCurr As *Ws_XmlDoc_St_Node Dim pNdEq As *Ws_XmlDoc_St_Node Dim nLen As Long Dim i As Long
'前準備。 SelectSingleNode_Parts = NULL strXPath = MakeStr( pszXPath ) pMark = StrPtr( strXPath )
'まずはXPATHを分割する。 '[/]の個数を数える。 nSlash = 0 While pMark[0]<>NULL If pMark[0]=47 Then nSlash += 1 End If pMark++ Wend
'分割格納用の配列を作成して入れる。 ppNdSrhArry = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nSlash+2)*SizeOf(Ws_XmlDoc_St_Node_Ptr) ) As *Ws_XmlDoc_St_Node_Ptr pnNodeListArry = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nSlash+2)*SizeOf(Long) ) As *Long ppszNodeTknArry = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nSlash+2)*SizeOf(BytePtr) ) As *BytePtr pnNodeTypeArry = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nSlash+2)*SizeOf(Long) ) As *Long ppszNodeCndtArry = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nSlash+2)*SizeOf(BytePtr) ) As *BytePtr pnNodeCndtTypeArry = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nSlash+2)*SizeOf(Long) ) As *Long i = 0 pMark = StrPtr( strXPath ) pIn = pMark pOut = NULL nNodeType = WsAB_Cnst_Node_Element While TRUE Select Case pMark[0] Case 47, NULL '=[/], Null-Out fNullOut = 1 and ( pMark[0]=NULL ) pOut = pMark pOut[0] = NULL If pOut=pIn Then strElem = "/" Else strElem = MakeStr( pIn ) End If
pnNodeListArry[ i ] = 0 '※配列指定無しを意味する。XPathの配列指定は「1」から始まることに注意 pIn = lstrchr_Xml( StrPtr(strElem), 91 ) '="[" If pIn<>NULL Then pOut = lstrchr_Xml( pIn, 93 ) '="]" pOutPrv = lstrchr_Xml( pIn, 39 ) '="'" 'こんなヤツへの対策⇒「 elem[ text()='hoge[fuga]dmy'] 」 If pOutPrv<>NULL Then pOutPrv = lstrchr_Xml( pOutPrv+1, 39 ) '="'" End If While pOut<>NULL and pOut<pOutPrv pOut = lstrchr_Xml( pOutPrv+1, 93 ) '="]" Wend If pOut<>NULL Then pIn[0] = NULL pOut[0] = NULL If NULL<>lstrstr_Xml( pIn+1, "text()" ) Then pIn = lstrstr_Xml( pIn+1, "text()" ) pIn = lstrstr_Xml( pIn, "'" ) If pIn<>NULL Then pOut = lstrstr_Xml( pIn+1, "'" ) If pOut<>NULL Then pIn[0] = NULL pOut[0] = NULL nLen = lstrlen( pIn+1 ) ppszNodeCndtArry[ i ] = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nLen+1)*SizeOf(BytePtr) ) As BytePtr lstrcpy( ppszNodeCndtArry[ i ], pIn+1 ) '※現時点では意味を持たない。 pnNodeCndtTypeArry[ i ] = FALSE Else pnNodeListArry[ i ] = 0 '※配列指定無しを意味する。XPathの配列指定は「1」から始まることに注意 End If Else pnNodeListArry[ i ] = 0 '※配列指定無しを意味する。XPathの配列指定は「1」から始まることに注意 End If Else pnNodeListArry[ i ] = Val( pIn+1 ) End If
'"[~]"を外したものを要素として再設定。 strElem = StrPtr( strElem ) End If End If
nLen = Len( strElem ) ppszNodeTknArry[ i ] = HeapAlloc( hXmlNodeHeap, HEAP_ZERO_MEMORY, (nLen+1)*SizeOf(BytePtr) ) As BytePtr lstrcpy( ppszNodeTknArry[ i ], StrPtr( strElem ) )
pnNodeTypeArry[ i ] = nNodeType
strElem = ""
If fNullOut Then Exit While End If pIn = pMark + 1 pOut = NULL i++ nNodeType = WsAB_Cnst_Node_Element '次の検索ノードのタイプの初期値を設定。
Case 64 '=[@] nNodeType = WsAB_Cnst_Node_Attribute pIn++
Case 91 '="[" pOut = lstrchr_Xml( pMark+1, 93 ) '="]" If pOut<>NULL Then pMark = pOut pOut = NULL End If
Case Else
End Select
pMark++ Wend ppszNodeTknArry[ i+1 ] = NULL
'※現状「/*」は扱えないので、「../*」も不可。 ' しかし「../*」に限り先行対応するため、ここで処理する。 If i=1 Then If 0=lstrcmp( ppszNodeTknArry[ 0 ], ".." ) and 0=lstrcmp( ppszNodeTknArry[ 1 ], "/" ) Then HeapFree( hXmlNodeHeap, 0, ppszNodeTknArry[ 1 ] ) ppszNodeTknArry[ 1 ] = NULL End If End If
'検索する。 nXPath = 0 If 0=lstrcmp( ppszNodeTknArry[ 0 ], "/" ) Then ppNdSrhArry[ nXPath ] = NULL ppNdSrhArry[ nXPath+1 ] = GetRootNodeSt( pNodeConnectSt )
Else If 0=lstrcmp( ppszNodeTknArry[ 0 ], "." ) Then ppNdSrhArry[ nXPath ] = pNodeConnectSt ppNdSrhArry[ nXPath+1 ] = pNodeConnectSt->pNodeChild
Else If 0=lstrcmp( ppszNodeTknArry[ 0 ], ".." ) Then ppNdSrhArry[ nXPath ] = pNodeConnectSt->pNodeParent ppNdSrhArry[ nXPath+1 ] = pNodeConnectSt
Else '※コレはありえない:"./"の正規化を上でやっておこう。
End If nXPath++ If ppszNodeTknArry[ nXPath ]=NULL Then pNdEq = ppNdSrhArry[ nXPath-1 ] Else pNdEq = NULL End If While ppszNodeTknArry[ nXPath ]<>NULL If ppNdSrhArry[ nXPath ]=NULL Then '検索先のノードが無い:エラー pNdEq = NULL Exit While
Else
fMatch = FALSE While ppNdSrhArry[ nXPath ]<>NULL pNdCurr = ppNdSrhArry[ nXPath ] If 0=lstrcmp( ppszNodeTknArry[ nXPath ], pNdCurr->pszItem ) Then fMatch = TRUE If ppszNodeCndtArry[ nXPath ]<>NULL and NULL<>pNdCurr->pNodeChild Then If 0=lstrcmp( ppszNodeCndtArry[ nXPath ], pNdCurr->pNodeChild->pszItem ) Then Exit While Else ppNdSrhArry[ nXPath ] = pNdCurr->pNodeNext fMatch = FALSE End If Else If pnNodeListArry[ nXPath ]=0 Then Exit While
Else If pnNodeListArry[ nXPath ]=1 Then Exit While
Else pnNodeListArry[ nXPath ] -= 1 ppNdSrhArry[ nXPath ] = pNdCurr->pNodeNext fMatch = FALSE
End If Else ppNdSrhArry[ nXPath ] = pNdCurr->pNodeNext
End If Wend If pnNodeTypeArry[ nXPath ] <> pNdCurr->dwNodeType Then fMatch = FALSE End If If fMatch Then pNdEq = ppNdSrhArry[ nXPath ] ppNdSrhArry[ nXPath+1 ] = pNdCurr->pNodeChild nXPath++
Else pNdEq = NULL pNdCurr = ppNdSrhArry[ nXPath-1 ] If pNdCurr=NULL Then Exit While End If ppNdSrhArry[ nXPath-1 ] = pNdCurr->pNodeNext nXPath--
End If If nXPath=<1 Then '検索終了:見つからず。 pNdEq = NULL Exit While End If
End If Wend
If pNdEq<>NULL Then SelectSingleNode_Parts = pNdEq->pXmlNode Else SelectSingleNode_Parts = NULL End If
'使った配列を開放する。 i = 0 While i<nSlash HeapFree( hXmlNodeHeap, 0, ppszNodeTknArry[ i ] ) HeapFree( hXmlNodeHeap, 0, ppszNodeCndtArry[ i ] ) i++ Wend HeapFree( hXmlNodeHeap, 0, ppszNodeTknArry ) HeapFree( hXmlNodeHeap, 0, pnNodeListArry ) HeapFree( hXmlNodeHeap, 0, ppNdSrhArry ) HeapFree( hXmlNodeHeap, 0, pnNodeTypeArry ) HeapFree( hXmlNodeHeap, 0, ppszNodeCndtArry ) HeapFree( hXmlNodeHeap, 0, pnNodeCndtTypeArry ) End Function
End Class
'ABフォーラムへの投稿の都合上、ここで別途定義。。。 '古いライブラリなので#ifndefし忘れてた。。。
Declare Function lstrchr_Xml Lib "shlwapi" Alias "StrChrIA" _ ( pBuffer1 As BytePtr, _ bSearch2 As Byte ) As BytePtr
Declare Function lstrstr_Xml Lib "shlwapi" Alias "StrStrIA" _ ( pBuffer1 As BytePtr, _ pBuffer2 As BytePtr ) As BytePtr
#endif [/code][/hide]
[b]3.サンプル[/b] 3.1.追加ライブラリ不要版 ※上記のクラス本体の定義は略してます。 [hide=※長いのでここをクリック][code] Dim objXmlDoc As WsAB_XmlDocument Dim pobjXmlNode As WsAB_XmlNodePtr Dim pobjXmlNode_Elem As WsAB_XmlNodePtr Dim pobjXmlNode_Text As WsAB_XmlNodePtr
Dim s As String
'サンプル:XMLをテキストで設定して、XMLファイルへ出力する。 s = "<root><config><test>aaaa</test><test>bbbb</test></config>" s = s + "<config><test>hoge</test></config></root>" objXmlDoc.LoadXml( s ) objXmlDoc.Save( "dbg_0base.xml" )
'サンプル:XPathでノードを選択して、テキスト内容を書き換える。 ' その後XMLファイルへ出力する。 s = "/root/config/test" pobjXmlNode = objXmlDoc.SelectSingleNode( s ) Msgbox 0, pobjXmlNode->FirstChild->Value(), "1st: "+s pobjXmlNode->FirstChild->Value( "change" ) objXmlDoc.Save( "dbg_1st.xml" )
'サンプル:XPathでノードをテキスト判定つきで選択する。 s = "/root/config/test[ text()='hoge' ]" pobjXmlNode = objXmlDoc.SelectSingleNode( s ) Msgbox 0, pobjXmlNode->FirstChild->Value(), "2st: "+s
'サンプル:選択したノードの一つ上の階層を選択する。 ' ⇒それを親として新規ノードを追加して、XMLファイルへ出力する。 s = "../" pobjXmlNode = pobjXmlNode->SelectSingleNode( s ) pobjXmlNode_Elem = objXmlDoc.CreateElement( "add_node" ) pobjXmlNode_Text = objXmlDoc.CreateTextNode( "追加したノード" ) pobjXmlNode_Elem->AppendChild( pobjXmlNode_Text ) pobjXmlNode->AppendChild( pobjXmlNode_Elem ) objXmlDoc.Save( "dbg_2nd.xml" )
'サンプル:XPathでノードを配列的に選択して、エレメント名を変更する。 ' その後XMLファイルへ出力する。 s = "/root/config[2]" pobjXmlNode = objXmlDoc.SelectSingleNode( s ) Msgbox 0, pobjXmlNode->Name(), "3rd: "+s pobjXmlNode->Name( "variable" ) objXmlDoc.Save( "dbg_3rd.xml" )
End
/* ---------------------------------------------------------------- WSLib7_FileRW.sbp ファイルへの読み書きを簡単に扱うクラスWsFileReadWrite。 CreateFile()、ReadFile()の引数をいちいち定義するのが面倒で、 その回避と自動バッファ確保を目的としている。 ※テキストに限らず扱えます。
作成:淡幻星 ---------------------------------------------------------------- */ #ifndef _FILE_RW_ #define _FILE_RW_
Class WsFileReadWrite pReadSource As BytePtr 'ファイル読み取りバッファ pWriteSource As BytePtr 'ファイル書き込みバッファ nByteWrite As DWord '書き込むバイト数。 nBytesRead As DWord '読み込んだバイト数
hHeap As DWord fContentsTF As Long fOutBufferTF As Long hFileWrite As HANDLE 'ファイルハンドル(書き込み時にのみ利用してます)。
Public 'コンストラクタ Sub WsFileReadWrite() hHeap = HeapCreate( NULL, NULL, NULL ) fContentsTF = FALSE fOutBufferTF = FALSE hFileWrite = NULL End Sub 'デストラクタ Sub ~WsFileReadWrite() If( hFileWrite<>NULL )Then CloseHandle( hFileWrite ) hFileWrite = NULL End If HeapDestroy( hHeap ) End Sub
'ファイルを読み込む@全部。 Function OpenFile( pTargetFile As BytePtr ) As Long OpenFile = OpenFileEx( pTargetFile, 0 ) EndFunction 'ファイルを読み込む@任意のサイズで。dwReadByte=0にすると、すべて読み込む。 Function OpenFileEx( pTargetFile As BytePtr, dwReadByte As DWord ) As Long Dim retAns As Long Dim hFile As DWord Dim nSize As DWord
'ターゲットファイルをオープン hFile = CreateFile( pTargetFile, GENERIC_READ, 0, ByVal NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL ) If( hFile=INVALID_HANDLE_VALUE )Then OpenFileEx = FALSE ExitFunction EndIf '読み込むサイズの指定。 If( dwReadByte=0 )Then 'ファイルサイズを得る。 nSize = GetFileSize( hFile, 0 ) Else nSize = dwReadByte EndIf '読み取りバッファの確保 If( fContentsTF=FALSE )Then pReadSource = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nSize + 4*2 ) Else retAns = HeapFree( hHeap, NULL, pReadSource ) pReadSource = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nSize + 4*2 ) EndIf 'ファイルを全てバッファに読み込む。 retAns = ReadFile( hFile, _ pReadSource, _ nSize, _ VarPtr( nBytesRead ), _ ByVal NULL ) '読み取りが終了したのでファイルをクローズ retAns = CloseHandle( hFile )
fContentsTF = TRUE OpenFileEx = TRUE EndFunction
'読み込みバッファを開放 Function CloseFile() As Long Dim retAns As Long retAns = HeapFree( hHeap, NULL, pReadSource ) fContentsTF = FALSE EndFunction
'読み込んだバイト数を得る Function WhatByte() As Long Dim retAns As Long If( fContentsTF=FALSE )Then WhatByte = NULL Else WhatByte = nBytesRead EndIf EndFunction
'読み込んだ内容を得る。 Function GetContents() As BytePtr If( fContentsTF=FALSE )Then GetContents = NULL Else GetContents = pReadSource EndIf EndFunction
'読み込んだ内容をコピーする '※TEXTかそうでないかに関わらず、コピーを行う。 Function CpyContents( pTargetBuf As VoidPtr ) As Long Dim pMark As Long
If( fContentsTF=FALSE )Then CpyContents = FALSE Else memcpy( pTargetBuf, pReadSource, nBytesRead ) CpyContents = TRUE EndIf EndFunction
'書き込む内容をセットする@TEXTに特化 Function SetContentsTEXT( pBuffer As BytePtr ) As Long Dim nSize As DWord Dim pMark As BytePtr Dim retAns As Long
nSize = lstrlen( pBuffer ) + 1 If( fOutBufferTF=FALSE )Then pWriteSource = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nSize ) Else retAns = HeapFree( hHeap, NULL, pWriteSource ) pWriteSource = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nSize ) EndIf pMark = lstrcpy( pWriteSource, pBuffer ) If( pMark=NULL )Then SetContentsTEXT = FALSE Else SetContentsTEXT = TRUE nByteWrite = nSize - 1 EndIf
fOutBufferTF = TRUE EndFunction
'書き込む内容をセットする@汎用 Function SetContents( pBuffer As VoidPtr, nSize As Long ) As Long Dim retAns As Long
If( fOutBufferTF=FALSE )Then pWriteSource = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nSize ) Else retAns = HeapFree( hHeap, NULL, pWriteSource ) pWriteSource = HeapAlloc( hHeap, HEAP_ZERO_MEMORY, nSize ) EndIf If( pWriteSource=NULL )Then SetContents = FALSE ExitFunction Else SetContents = TRUE EndIf memcpy( pWriteSource, pBuffer, nSize ) nByteWrite = nSize
fOutBufferTF = TRUE EndFunction
'セットされた内容を書き込む@ワンス Function WriteContents( pTargetFile As BytePtr ) As Long If( fOutBufferTF=FALSE )Then WriteContents = FALSE Else If( TRUE=WriteContents_Open( pTargetFile ) )Then WriteContents = WriteContents_Packet( pWriteSource, nByteWrite ) HeapFree( hHeap, NULL, pWriteSource ) nByteWrite = 0 fOutBufferTF = FALSE WriteContents_Close() Else WriteContents = FALSE End If EndIf End Function 'セットされた内容を書き込む@パケット Function WriteContents_Open( pTargetFile As BytePtr ) As Long Dim retAns As Long Dim dwLastAttributes As DWord
'ファイルが既に存在しているなら、属性を保持。 dwLastAttributes = GetFileAttributes( pTargetFile ) If( dwLastAttributes=&HFFFFFFFF )Then dwLastAttributes = FILE_ATTRIBUTE_NORMAL End If
'書き込み先を上書きオープン hFileWrite = CreateFile( pTargetFile, GENERIC_WRITE, 0, ByVal NULL, CREATE_ALWAYS, dwLastAttributes, NULL ) If( hFileWrite=INVALID_HANDLE_VALUE )Then hFileWrite = NULL WriteContents_Open = FALSE Else WriteContents_Open = TRUE EndIf
End Function Function WriteContents_Packet( pBuf As BytePtr, nLength As Long ) As Long Dim nSize As DWord Dim nBytesWrite As DWord
If( hFileWrite=NULL )Then WriteContents_Packet = 0 ExitFunction End If
'バッファのデータをファイルに書き込む。 WriteContents_Packet = WriteFile( hFileWrite, pBuf, nLength, VarPtr( nBytesRead ), ByVal NULL ) EndFunction Sub WriteContents_Close() '書き込みが終了したのでファイルのクローズ If( hFileWrite<>NULL )Then CloseHandle( hFileWrite ) hFileWrite = NULL End If End Sub
End Class #endif [/code][/hide]
3.2.AB淡幻ライブラリ利用版 ※上記のクラス本体の定義は略してます。 [code] #include <WSLib7_AB_Distrbution.sbp>
Dim objXmlDoc As WsAB_XmlDocument Dim pobjXmlNode As WsAB_XmlNodePtr Dim pobjXmlNode_Elem As WsAB_XmlNodePtr Dim pobjXmlNode_Text As WsAB_XmlNodePtr
Dim s As String
'サンプル:XMLをテキストで設定して、XMLファイルへ出力する。 s = "<root><config><test>aaaa</test><test>bbbb</test></config>" s = s + "<config><test>hoge</test></config></root>" objXmlDoc.LoadXml( s ) objXmlDoc.Save( "dbg_0base.xml" )
'サンプル:XPathでノードを選択して、テキスト内容を書き換える。 ' その後XMLファイルへ出力する。 s = "/root/config/test" pobjXmlNode = objXmlDoc.SelectSingleNode( s ) Msgbox 0, pobjXmlNode->FirstChild->Value(), "1st: "+s pobjXmlNode->FirstChild->Value( "change" ) objXmlDoc.Save( "dbg_1st.xml" )
'サンプル:XPathでノードをテキスト判定つきで選択する。 s = "/root/config/test[ text()='hoge' ]" pobjXmlNode = objXmlDoc.SelectSingleNode( s ) Msgbox 0, pobjXmlNode->FirstChild->Value(), "2st: "+s
'サンプル:選択したノードの一つ上の階層を選択する。 ' ⇒それを親として新規ノードを追加して、XMLファイルへ出力する。 s = "../" pobjXmlNode = pobjXmlNode->SelectSingleNode( s ) pobjXmlNode_Elem = objXmlDoc.CreateElement( "add_node" ) pobjXmlNode_Text = objXmlDoc.CreateTextNode( "追加したノード" ) pobjXmlNode_Elem->AppendChild( pobjXmlNode_Text ) pobjXmlNode->AppendChild( pobjXmlNode_Elem ) objXmlDoc.Save( "dbg_2nd.xml" )
'サンプル:XPathでノードを配列的に選択して、エレメント名を変更する。 ' その後XMLファイルへ出力する。 s = "/root/config[2]" pobjXmlNode = objXmlDoc.SelectSingleNode( s ) Msgbox 0, pobjXmlNode->Name(), "3rd: "+s pobjXmlNode->Name( "variable" ) objXmlDoc.Save( "dbg_3rd.xml" )
End [/code]
[b]4.動作確認環境[/b] ActiveBasic: 4.24.00 OS: Windows XP SP3
以上ー。
[size=75] [color=red] 2009.11.08 存在しないXPathに対して、最後に存在した上位ノードを返すバグ(本来はNULL応答が正しい)を修正 2009.11.29 ノード削除メソッドにバグ(終端のノードを削除時に前後接続が不正になる)があったので修正。 2011.10.15 偶にアプリケーションエラーで落ちるバグを修正(null終端の直後のアドレスへの違反アクセスが発生することがあった)。 2011.11.25 コメント内部に「<」があると(=javascriptとか)ノードを取得できないバグを修正。 [/color] [/size]
[color=#777777] P.S. コメントがあちこち抜けてますが、気力があればそのうち追記します。。。 P.S. x2 一応、InsertAfter()、InsertBefore()、InnerText()、 SelectSingleNode()でのContains()サポートあたりは追加したいと思ってますが、、、 これも気力があればm(_ _)m P.S. x3 大元のMSXMLの呼び出すパターンの投稿は大歓迎です♪
# コミュニティ復活おめでとうございます。 # ・・・しかし動作が重いっすねぇ。。。(^^;) [/color]
|