ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2017年9月22日(金) 11:29

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 1 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2009年11月01日(日) 21:23 
オフライン

登録日時: 2005年7月19日(火) 07:02
記事: 183
住所: 宮城県
XMLを扱う場合は、MSXMLのXmlDocument あたりを
利用することが多いと思います。

しかし
AB上からは、これら(COM?)の呼び方がイマイチ分からない/複雑。┐(-ε-)┌
というわけで、同じI/FのクラスをAB用に作成してみました。

XPathを使う必要性に迫られたので、その辺を中心に。
極力同じメソッド名&操作性にしているので、他の言語(VC++,VB,C#等)で
本来のMSXMLを利用する際も混乱しないと思います。

# あ、特殊記号「&'<>'」は内部で勝手にエンティティと変換します。
# なので、クラス越しにXMLを読み書きする際は、そのまま直に記号を扱えます。
# そこは本家MSXML利用より便利かも?

(※当方が必要とするメソッド/メンバしか実装/定義してませんのでアシカラズ)。

1.作成クラスの概要
[hide=■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
[/hide]
[hide=■WsAB_XmlDocument_NoAddLibクラス]
  ⇒a)XmlDocumentクラス相当。
    b)追加のライブラリは不要。
    c)基底クラス:WsAB_XmlNodeクラス
    d)メソッド:
      Function LoadXml( pszXmlText As BytePtr ) As Char
    e)メソッド:無し
[/hide]
[hide=■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)メソッド:無し
[/hide]


2.クラスの定義(コード)
[hide=※長いのでここをクリック]
コード:
/*
	[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( "&apos;", 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, "&apos;", 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
[/hide]


3.サンプル
3.1.追加ライブラリ不要版
※上記のクラス本体の定義は略してます。
[hide=※長いのでここをクリック]
コード:
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
[/hide]

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 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[1人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke