ab.com コミュニティ https://www.activebasic.com/forum/ |
|
AB上でXML(XPath)を扱うクラス https://www.activebasic.com/forum/viewtopic.php?t=2605 |
ページ 1 / 1 |
作成者: | 淡幻星 [ 2009年11月01日(日) 21:23 ] |
記事の件名: | AB上でXML(XPath)を扱うクラス |
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 ■WsAB_XmlDocument_NoAddLibクラス [ここをクリックすると内容が表示されます]
⇒a)XmlDocumentクラス相当。 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)メソッド:無し 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の呼び出すパターンの投稿は大歓迎です♪ # コミュニティ復活おめでとうございます。 # ・・・しかし動作が重いっすねぇ。。。(^^;) |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |