利用することが多いと思います。
しかし。
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
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
■WsAB_XmlDocument_NoAddLibクラス [ここをクリックすると内容が表示されます]
⇒a)XmlDocumentクラス相当。
b)追加のライブラリは不要。
c)基底クラス:WsAB_XmlNodeクラス
d)メソッド:
Function LoadXml( pszXmlText As BytePtr ) As Char
e)メソッド:無し
b)追加のライブラリは不要。
c)基底クラス:WsAB_XmlNodeクラス
d)メソッド:
Function LoadXml( pszXmlText As BytePtr ) As Char
e)メソッド:無し
■WsAB_XmlDocumentクラス [ここをクリックすると内容が表示されます]
⇒a)XmlDocumentクラス相当。
※上記WsAB_XmlDocument_NoAddLibクラスの機能拡張版
b)追加のライブラリとして、AB淡幻ライブラリが必要。
※追加ライブラリを入れたく無い場合は、
利用クラスのソースコードのみ追加したサンプルを
別途掲載してますので、そっちを使ってもらえればOKです。
c)基底クラス:WsAB_XmlDocument_NoAddLibクラス
d)メソッド:
Function Load( pszFilePath As BytePtr ) As Char
Function Save( pszFilePath As BytePtr ) As Char
e)メソッド:無し
※上記WsAB_XmlDocument_NoAddLibクラスの機能拡張版
b)追加のライブラリとして、AB淡幻ライブラリが必要。
※追加ライブラリを入れたく無い場合は、
利用クラスのソースコードのみ追加したサンプルを
別途掲載してますので、そっちを使ってもらえればOKです。
c)基底クラス:WsAB_XmlDocument_NoAddLibクラス
d)メソッド:
Function Load( pszFilePath As BytePtr ) As Char
Function Save( pszFilePath As BytePtr ) As Char
e)メソッド:無し
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の呼び出すパターンの投稿は大歓迎です♪
# コミュニティ復活おめでとうございます。
# ・・・しかし動作が重いっすねぇ。。。(^^;)