ab.com コミュニティ

設定ファイルとして使われているiniファイルとXMLファイルに対する処理を行うクラスです。

iniファイルクラス
ソース


#ifndef _INC_CL_INI
#define _INC_CL_INI


'////////  Win32API宣言  ////////
Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (pSectionName As BytePtr, pKeyName As BytePtr, nDefault As Long, pProfileName As BytePtr) As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (pSectionName As BytePtr, pKeyName As BytePtr, pDefault As BytePtr, pBuffer As BytePtr, nBufferLength As Dword, pProfileName As BytePtr) As Dword
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (pSectionName As BytePtr, pKeyName As BytePtr, pString As BytePtr, pProfileName As BytePtr) As Long
'Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (pSectionName As BytePtr, pBuffer As BytePtr, nBufferLength As Dword, pProfileName As BytePtr) As Dword
'Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (pSectionName As BytePtr, pString As BytePtr, pProfileName As BytePtr) As Long
'Declare Function GetPrivateProfileSectionNames Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" (pBuffer As BytePtr, nBufferLength As Dword, pProfileName As BytePtr) As Dword



'////////  定数  ////////
Const PP_MAXBUF		= 1023



'////////  オブジェクトインターフェース  ////////
Interface iProfileSection
	Function GetInt(Key As BytePtr) As Long
	Function SetInt(Key As BytePtr, Value As Long) As Long

	Function GetStr(Key As BytePtr) As BytePtr
	Function SetStr(Key As BytePtr, Value As BytePtr) As Long

	Function DeleteSection() As Long
	Function DeleteKey(Key As BytePtr) As Long

	Function GetStrCrlf(Key As BytePtr) As BytePtr
	Function SetStrCrlf(Key As BytePtr, Str As BytePtr) As Long
End Interface



'////////  管理クラス  ////////
Class cPrivateProfileManager

	Private: File As BytePtr
	Private: DefInt As Long
	Private: DefStr As BytePtr


	Public '////////  コンストラクタ  ////////
	Sub cPrivateProfileManager(FilePath As BytePtr, DefaultInt As Long, DefaultStr As BytePtr)

		'=====  ファイルパスの設定  =====
		If 0 <> FilePath then
			File = calloc(lstrlen(FilePath)+1)
			lstrcpy(File, FilePath)
		Else
			Dim ModulePath[PP_MAXBUF] As Byte, ctr As Long
			ctr = GetModuleFileName(0, ModulePath, PP_MAXBUF+1)
			Do
				ctr -= 1
				If 0 = ctr then return
				If Asc(".") = ModulePath[ctr] then Exit Do
			Loop
			ModulePath[ctr+1] = 0
			File = calloc(lstrlen(ModulePath)+3+1)
			wsprintf(File, "%sini", ModulePath)
		End If

		'=====  デフォルト値の設定  =====
		DefInt = DefaultInt
		DefStr = calloc(lstrlen(DefaultStr)+1): lstrcpy(DefStr, DefaultStr)

	End Sub


	Public '////////  デストラクタ  ////////
	Sub ~cPrivateProfileManager()
		free(File)
		free(DefStr)
	End Sub


	Public '////////  オブジェクト生成  ////////
	Function CreateObject(Section As BytePtr) As *iProfileSection
		return New cPrivateProfileObj(File, Section, DefInt, DefStr)
	End Function


	Public '////////  オブジェクト破棄  ////////
	Sub DeleteObject(Obj As *iProfileSection)
		Delete Obj
	End Sub


End Class





'////////  オブジェクトクラス  ////////
Class cPrivateProfileObj: Inherits iProfileSection

	Private: File As BytePtr
	Private: Section As BytePtr
	Private: DefInt As Long
	Private: DefStr As BytePtr

	Private: strbuf[PP_MAXBUF] As Byte


	Public '////////  コンストラクタ  ////////
	Sub cPrivateProfileObj(FilePath As BytePtr, SectionName As BytePtr, DefaultInt As Long, DefaultStr As BytePtr)

		File = calloc(lstrlen(FilePath)+1): lstrcpy(File, FilePath)
		Section = calloc(lstrlen(SectionName)+1): lstrcpy(Section, SectionName)
		DefInt = DefaultInt
		DefStr = calloc(lstrlen(DefaultStr)+1): lstrcpy(DefStr, DefaultStr)
	End Sub


	Public '////////  デストラクタ  ////////
	Sub ~cPrivateProfileObj()
		free(File)
		free(Section)
		free(DefStr)
	End Sub


	Public '////////  数値取得  ////////
	Override _
	Function GetInt(Key As BytePtr) As Long
		return GetPrivateProfileInt(Section, Key, DefInt, File)
	End Function


	Public '////////  数値設定  ////////
	Override _
	Function SetInt(Key As BytePtr, Value As Long) As Long
		Dim buf[31] As Byte
		wsprintf(buf, "%d", Value)
		If 0 = WritePrivateProfileString(Section, Key, buf, File) then return FALSE
		return TRUE
	End Function


	Public '////////  文字列取得  ////////
	Override _
	Function GetStr(Key As BytePtr) As BytePtr
		GetPrivateProfileString(Section, Key, DefStr, strbuf, PP_MAXBUF, File)
		return strbuf
	End Function


	Public '////////  文字列設定  ////////
	Override _
	Function SetStr(Key As BytePtr, Str As BytePtr) As Long
		If 0 = WritePrivateProfileString(Section, Key, Str, File) then return FALSE
		return TRUE
	End Function


	Public '////////  セクション消去  ////////
	Override _
	Function DeleteSection() As Long
		If 0 = WritePrivateProfileString(Section, 0, 0, File) then return FALSE
		return TRUE
	End Function


	Public '////////  キー消去  ////////
	Override _
	Function DeleteKey(Key As BytePtr) As Long
		If 0 = WritePrivateProfileString(Section, Key, 0, File) then return FALSE
		return TRUE
	End Function


	Public '////////  改行コードを含む文字列の設定  ////////
	Override _
	Function SetStrCrlf(Key As BytePtr, Str As BytePtr) As Long

		Dim i=0 As Long, j=0 As Long

		Do
			Select case Str[j]
			Case Asc(Ex"\0")
				Exit Do

			Case Asc(Ex"\r")
				strbuf = Asc(""): i++

			Case Asc(Ex"\n")
				strbuf = Asc("r"): i++

			Case Asc("")
				If PP_MAXBUF = (i+1) then Exit Do
				strbuf = Asc(""): i++
				strbuf = Asc(""): i++

			Case Else
				strbuf = Str[j]: i++

			End Select

			j++
			If PP_MAXBUF = i then Exit Do
		Loop

		strbuf = Asc(Ex"\0")
		return SetStr(Key, strbuf)
	End Function


	Public '////////  改行コードを含む文字列の取得  ////////
	Override _
	Function GetStrCrlf(Key As BytePtr) As BytePtr

		Dim src As BytePtr
		Dim dest As BytePtr
		Dim i=0 As Long, j=0 As Long

		src = GetStr(Key)
		dest = calloc(lstrlen(src)+1)
		Do
			If Asc("") = src[j] then
				j++
				Select case src[j]
				Case Asc("r")
					dest = Asc(Ex"\r"): i++
					dest = Asc(Ex"\n"): i++
				Case Else
					dest = Asc(""): i++
				End Select

			Else
				dest = src[j]: i++
				If Asc(Ex"\0") = src[j] then Exit Do

			End If

			j++
		Loop

		lstrcpy(strbuf, dest)
		free(dest)
		return strbuf
	End Function


End Class


#endif '_INC_CL_INI

使い方

[ここをクリックすると内容が表示されます]

XMLファイルクラス
＜注意事項＞
・XML文書の1行目に書かれているXML宣言は無視されます。出力にも宣言は含まれません。
・XMLはUnicodeがデフォルトだったと思いますが、これはシフトJIS専用です。

ソース

[ここをクリックすると内容が表示されます]

[1] インターフェース

[ここをクリックすると内容が表示されます]

コード: 全て選択

Interface iXmlElement

	'=====  ファイルIO  =====

	'XML文書からデータを読み込む。読み込み失敗時はデータは中途半端に構築された状態になる。
	Function Load(File As BytePtr) As Long'(T/F)

	'XML文書を出力する。同名のファイルが存在する場合は「fUpdate」にTRUE指定で上書きされる。
	Function Dump(File As BytePtr, fUpdate As Long) As Long'(T/F)


	'=====  要素名  =====
	'要素名を取得する。
	Function GetName() As BytePtr


	'=====  属性  =====

	'属性の総数を取得する
	Function GetAttributeTotal() As Long

	'属性名を指定して属性の値を取得する
	Function GetAttribute(Name As BytePtr) As BytePtr'(ptr/0)

	'既存の属性を設定する。（指定された属性名が無い場合は失敗する）
	Function SetAttribute(Name As BytePtr, Param As BytePtr) As Long'(T/F)

	'属性を新規作成する。（指定された属性名が存在する場合は失敗する）
	Function CreateAttribute(Name As BytePtr, Param As BytePtr) As Long'(T/F)

	'属性を削除する。
	Function DeleteAttribute(Name As BytePtr) As Long'(T/F)

	'属性名を列挙する
	Function EnumAttributeName(fInit As Long) As BytePtr'(ptr/0)


	'=====  値  =====

	'要素の値を取得する。（子要素が存在する場合は失敗する）
	Function GetValue() As BytePtr'(ptr/0)

	'要素の値を設定する。（子要素が存在する場合は失敗する）
	Function SetValue(Value As BytePtr) As Long'(T/F)


	'=====  子要素  =====

	'子要素を作成する。
	Function CreateChild(Name As BytePtr, CreateObj As Long) As *iXmlElement'(obj+0)

	'子要素を削除する。同一の要素名が複数存在する場合はIndex(0～)で指定する。
	'Nameに「0」指定で全ての子要素が、Indexに-1指定で同一の要素名全てが削除される。
	Sub DeleteChild(Name As BytePtr, Index As Long)

	'子要素のオブジェクトを取得する。同一の要素名が複数存在する場合はIndex(0～)で指定する。
	Function GetChild(Name As BytePtr, Index As Long) As *iXmlElement'(obj/0)

	'取得したオブジェクトを解放する
	Sub ReleaseChild(obj As *iXmlElement)

	'子要素のオブジェクトを列挙する。
	Function EnumChild(fInit As Long) As *iXmlElement'(obj/0)

End Interface

[2] クラス内構造体

[ここをクリックすると内容が表示されます]

コード: 全て選択

Type XML_ATTRIBUTE
	name As BytePtr
	param As BytePtr
End Type


Type XML_ELEMENT
	name As BytePtr							' 要素名（変更不可）
	attribute As *cQueue'<*XML_ATTRIBUTE>	' 属性リスト

	'子要素が含まれていれば内容は無視される
	value As BytePtr						' 内容
	child As *cQueue'<*XML_ELEMENT>			' 子要素
End Type

[3] クラス（データ操作部分）

[ここをクリックすると内容が表示されます]

コード: 全て選択

Class cXmlElement: Inherits cXmlElement_Child

	'Protected: data As *XML_ELEMENT
	Private: fCreate As Long

	Public '////////  コンストラクタ  ////////
	Sub cXmlElement(Data As *XML_ELEMENT)
		If 0 = Data then
			fCreate = TRUE
			data = calloc(SizeOf(XML_ELEMENT))
			With data[0]
				.name = calloc(1)
				.attribute = New cQueue
				.value = calloc(1)
				.child = New cQueue
			End With

		Else
			fCreate = FALSE
			data = Data

		End If
	End Sub

	Public '////////  デストラクタ  ////////
	Sub ~cXmlElement()
		If TRUE = fCreate then DeleteElement(data)
	End Sub

End Class

'###############################################



Class cXmlElement_Child: Inherits cXmlElement_Value

	'Protected: data As *XML_ELEMENT


	Public '////////  子要素を作成  ////////
	Override _
	Function CreateChild(Name As BytePtr, CreateObj As Long) As *iXmlElement'(obj+0)

		Dim NewData As *XML_ELEMENT

		NewData = calloc(SizeOf(XML_ELEMENT))
		With NewData[0]
			.name		= calloc(lstrlen(Name)+1): lstrcpy(.name, Name)
			.attribute	= New cQueue
			.value		= calloc(1)
			.child		= New cQueue
		End With

		data->child->Enqueue(NewData)

		If TRUE = CreateObj then return New cXmlElement(NewData)
		return 0
	End Function



	Public '////////  子要素を削除  ////////
	Override _
	Sub DeleteChild(Name As BytePtr, Index As Long)
		'再帰で下位にある全データを破棄
		'Name=0: 全ての子要素  Index=-1: 指定した子要素全て

		Dim element As *XML_ELEMENT
		Dim total As Long, ctr As Long, index_child As Long

		total = data->child->GetSize()
		index_child = 0
		For ctr = 1 to total
			element = data->child->Dequeue()

			If 0 = Name then		'Name=0: 全ての子要素
				DeleteElement(element)

			Else If 0 = lstrcmp(Name, element->name) then
				If ( (-1=Index) or (index_child=Index) ) then	'Index=-1: 指定した子要素全て
					DeleteElement(element)
				Else
					data->child->Enqueue(element)
				End If
				index_child += 1

			Else
				data->child->Enqueue(element)

			End If
		Next

	End Sub


	Protected '--------  削除  --------
	Sub DeleteElement(Data As *XML_ELEMENT)

		free(Data->name)

		Dim attribute As *XML_ATTRIBUTE
		While (0 <> Data->attribute->GetSize())
			attribute = Data->attribute->Dequeue()
			free(attribute->name)
			free(attribute->param)
			free(attribute)
		Wend

		free(Data->value)

		Dim element As *XML_ELEMENT
		While (0 <> Data->child->GetSize())
			element = Data->child->Dequeue()
			DeleteElement(element)	'再帰処理
		Wend

		free(Data)

	End Sub


	Public '////////  子要素のオブジェクトを生成  ////////
	Override _
	Function GetChild(Name As BytePtr, Index As Long) As *iXmlElement'(obj/0)
		'Index:0～

		'=====  データを走査して指定された子要素を取得  =====
		Dim element As *XML_ELEMENT, ctr As Long
		ctr = 0
		data->child->PeekReset()
		Do
			If TRUE = data->child->PeekIsEnd() then return 0
			element = data->child->Peek()
			If 0 = lstrcmp(Name, element->name) then
				If ctr = Index then Exit Do
				ctr += 1
			End If
		Loop

		return New cXmlElement(element)
	End Function



	Public '////////  子要素のオブジェクトを破棄  ////////
	Override _
	Sub ReleaseChild(obj As *iXmlElement)
		Delete obj
	End Sub



	Public '////////  子要素を列挙  ////////
	Override _
	Function EnumChild(fInit As Long) As *iXmlElement'(obj/0)

		Dim element As *XML_ELEMENT

		If TRUE = fInit then data->child->PeekReset()

		If TRUE = data->child->PeekIsEnd() then return 0

		element = data->child->Peek()

		return New cXmlElement(element)
	End Function


End Class


'######################################



Class cXmlElement_Value: Inherits cXmlElement_Attribute

	'Protected: data As *XML_ELEMENT


	Public '////////  内容を取得  ////////
	Override _
	Function GetValue() As BytePtr'(ptr/0)
		If 0 <> data->child->GetSize() then return 0
		return data->value
	End Function


	Public '////////  内容を設定  ////////
	Override _
	Function SetValue(Value As BytePtr) As Long'(T/F)
		If 0 <> data->child->GetSize() then return FALSE
		free(data->value)
		data->value = calloc(lstrlen(Value)+1)
		lstrcpy(data->value, Value)
		return TRUE
	End Function


End Class



'######################################



Class cXmlElement_Attribute: Inherits cXmlElement_Element

	'Protected: data As *XML_ELEMENT


	Public '////////  属性の総数を取得  ////////
	Override _
	Function GetAttributeTotal() As Long
		return data->attribute->GetSize()
	End Function


	Public '////////  属性の値を取得  ////////
	Override _
	Function GetAttribute(Name As BytePtr) As BytePtr'(ptr/0)

		Dim attribute As *XML_ATTRIBUTE

		data->attribute->PeekReset()
		While (TRUE <> data->attribute->PeekIsEnd())
			attribute = data->attribute->Peek()
			If 0 = lstrcmp(Name, attribute->name) then return attribute->param
		Wend

		return 0
	End Function


	Public '////////  属性の値を設定  ////////
	Override _
	Function SetAttribute(Name As BytePtr, Param As BytePtr) As Long'(T/F)

		Dim attribute As *XML_ATTRIBUTE

		'=====  指定されたフィールドを探索
		data->attribute->PeekReset()
		Do
			If TRUE = data->attribute->PeekIsEnd() then return FALSE	'フィールドがなければ失敗
			attribute = data->attribute->Peek()
			If 0 = lstrcmp(Name, attribute->name) then Exit Do
		Loop

		'=====  フィールドの値を設定
		free(attribute->param)
		attribute->param = calloc(lstrlen(Param)+1)
		lstrcpy(attribute->param, Param)

		return TRUE
	End Function


	Public '////////  属性を新規作成  ////////
	Override _
	Function CreateAttribute(Name As BytePtr, Param As BytePtr) As Long'(T/F)

		'属性が存在すれば失敗
		If 0 <> GetAttribute(Name) then return FALSE

		'=====  データを作成
		Dim attribute As *XML_ATTRIBUTE
		attribute = calloc(SizeOf(XML_ATTRIBUTE))
		attribute->name = calloc(lstrlen(Name)+1): lstrcpy(attribute->name, Name)
		attribute->param = calloc(lstrlen(Param)+1): lstrcpy(attribute->param, Param)

		'=====  データ構造に追加
		data->attribute->Enqueue(attribute)

		return TRUE
	End Function


	Public '////////  属性を削除  ////////
	Override _
	Function DeleteAttribute(Name As BytePtr) As Long'(T/F)

		Dim total As Long, ctr As Long, flag As Long
		Dim attribute As *XML_ATTRIBUTE

		'=====  総数を取得  =====
		total = data->attribute->GetSize()

		'=====  データを走査  =====
		flag = FALSE
		For ctr = 1 to total
			attribute = data->attribute->Dequeue()
			If 0 = lstrcmp(Name, attribute->name) then
				'指定された属性なら削除
				free(attribute->name)
				free(attribute->param)
				free(attribute): flag = TRUE
			Else
				'その他のデータはキューに戻す
				data->attribute->Enqueue(attribute)
			End If
		Next

		return flag
	End Function


	Public '////////  属性を列挙  ////////
	Override _
	Function EnumAttributeName(fInit As Long) As BytePtr'(ptr/0)

		Dim attribute As *XML_ATTRIBUTE

		'初期化の指定があれば初期化
		If TRUE = fInit then data->attribute->PeekReset()

		'全ての属性を列挙した
		If TRUE = data->attribute->PeekIsEnd() then return 0

		attribute = data->attribute->Peek()
		return attribute->name
	End Function


End Class


'################################################

Class cXmlElement_Element: Inherits cXmlElement_Dump

	'Protected: data As *XML_ELEMENT


	Public '////////  要素名の取得  ////////
	Override _
	Function GetName() As BytePtr
		return data->name
	End Function


	Public '////////  要素名の設定(外部からの呼び出し禁止)  ////////
	Sub SetName(Name As BytePtr)
		free(data->name)
		data->name = calloc(lstrlen(Name)+1)
		lstrcpy(data->name, Name)
	End Sub


End Class

[4] クラス（ファイルIO部分）

[ここをクリックすると内容が表示されます]

コード: 全て選択

Class cXmlElement_Dump: Inherits cXmlElement_Parser

	Protected: data As *XML_ELEMENT


	Public '////////  XML文書形式で出力  ////////
	Override _
	Function Dump(File As BytePtr, fUpdate As Long) As Long'(T/F)

		Dim file As cFile(0), child As *XML_ELEMENT

		'ファイルを作成
		If FALSE = file.Create(File, GENERIC_WRITE, 0, fUpdate, FALSE) then return FALSE

		'XML宣言はここで書き込む(未実装)

		'オブジェクト上のルート要素直下の子要素を全て出力(規約違反かも？)
		data->child->PeekReset()
		While (TRUE <> data->child->PeekIsEnd())
			child = data->child->Peek()
			DumpElement(VarPtr(file), 0, child)
		Wend

		'ファイルを閉じる
		file.Close()

		return TRUE
	End Function


	Private '////////  深さを指定して要素をファイルに書き込む  ////////
	Sub DumpElement(file As *cFile, depth As Long, element As *XML_ELEMENT)

		Dim buf[4095] As Byte, ctr As Long

		'=====  開始タグの書き込み  =====
		Dim attribute As *XML_ATTRIBUTE

		'深さ分だけスペースを書き込む
		buf[0] = 0: For ctr = 1 to depth: lstrcpy(buf + lstrlen(buf), "  "): Next

		'要素名の書き込み
		wsprintf(buf+lstrlen(buf), "<%s", element->name)

		'属性の書き込み
		element->attribute->PeekReset()
		While (TRUE <> element->attribute->PeekIsEnd())
			attribute = element->attribute->Peek()
			wsprintf(buf+lstrlen(buf), Ex" %s=\q%s\q", attribute->name, attribute->param)
		Wend

		If 0 = element->child->GetSize() then
			'子要素が無い場合、値を書き込み、タグを閉じて書き込み、終了
			wsprintf(buf+lstrlen(buf), Ex">%s</%s>\r\n", element->value, element->name)
			file->Write(buf, lstrlen(buf))
			return
		Else
			'子要素がある場合、改行して書き込み
			wsprintf(buf+lstrlen(buf), Ex">\r\n")
			file->Write(buf, lstrlen(buf))
		End If


		'=====  子要素の書き込み  =====
		Dim child As *XML_ELEMENT

		element->child->PeekReset()
		While (TRUE <> element->child->PeekIsEnd())
			child = element->child->Peek()
			DumpElement(file, depth+1, child)	'1段階深くして再帰処理
		Wend


		'=====  閉じるタグの書き込み  =====

		'深さ分だけスペースを書き込む
		buf[0] = 0: For ctr = 1 to depth: lstrcpy(buf + lstrlen(buf), "  "): Next

		'終了タグの書き込み
		wsprintf(buf+lstrlen(buf), Ex"</%s>\r\n", element->name)
		file->Write(buf, lstrlen(buf))


	End Sub


End Class

'################################################



Enum PARSERINFO
	ROOT			'親要素直下（子要素の編集中ではない）
	INITCHILD		'子要素の開始
	ATTRIBUTE		'子要素の属性設定中
	VALUE			'子要素の値設定中
	ENDVALUE		'子要素の値設定完了
	ENDCHILD		'子要素の閉じるタグの値確認中
	FINISH			'子要素の閉じるタグの確認中
	NESTOUT			'子要素の設定終了(再帰の場合は復帰)

	ERROR			'構文エラー
End Enum


Class cXmlElement_Parser: Inherits iXmlElement


	Public '////////  XML文書からデータを読み込む  ////////
	Override _
	Function Load(File As BytePtr) As Long'(T/F)

		Dim taken As cQueue
		Select case FALSE

		'=====  トークンレベルに字句解析  =====
		Case Tokenization(File, VarPtr(taken))
			return FALSE

		'=====  構文解析＋データ構築  =====
		Case Parser(VarPtr(This), VarPtr(taken))
			While (0 <> taken.GetSize())
				free(taken.Dequeue())
			Wend
			return FALSE

		Case Else
			While (0 <> taken.GetSize())
				free(taken.Dequeue())
			Wend
			return TRUE

		End Select
	End Function


	'***********************************************************
	'    字句解析（Xml文書をトークンレベルに分解）
	'***********************************************************

	Private '////////  行ごとに分割し、トークン化を行う  ////////
	Function Tokenization(File As BytePtr, taken As *cQueue) As Long'(T/F)

		'=====  ファイルの内容を読み込み  =====
		Dim mem As BytePtr, size As DWord
		Dim file As cFile(0)
		If FALSE = file.Open(File, GENERIC_READ, 0, FALSE, FALSE) then return FALSE
		size = file.GetSize()
		mem = calloc(size+2+1)' 末尾に改行を付加が(ry
		memcpy(mem, file.Read(size), size)
		file.Close()


		'=====  置換作業を行い、1行ごとに分割する  =====
		Dim ctr As Long
		For ctr = 0 to size
			Select case mem[ctr]
			Case Asc(Ex"\r"): mem[ctr] = 0
			Case Asc(Ex"\t"): mem[ctr] = Asc(" ")
			End Select
		Next


		'=====  1行ずつトークン化を行う  =====
		Dim ptr As BytePtr, buffer As BytePtr, fInfo=FALSE As Long
		ptr = mem
		While ((0 <> ptr[0]) or (Asc(Ex"\n") = ptr[1])) '空ファイルでも抜けれる

			'XML宣言の処理
			If FALSE = fInfo then	'1行目にある場合のみ処理
				If ( (Asc("<")=ptr[0]) and (Asc("?")=ptr[1]) ) then ptr += lstrlen(ptr) + 2
				fInfo = TRUE
			End If

			'空行以外をトークン化
			If 0 <> ptr[0] then TokenSeparate(ptr, taken)

			'1行分進める
			ptr += lstrlen(ptr) + 2
		Wend

		'=====  読み込んだファイルの内容を破棄  =====
		free(mem)

		return TRUE
	End Function



	Private '////////  指定された行をトークンレベルに分割し、キューに格納  ////////
	Sub TokenSeparate(Text As BytePtr, taken As *cQueue)

		Dim ptr As BytePtr: ptr = Text

		Dim init=0 As BytePtr
		Dim fStr=FALSE As Long, fField=FALSE As Long


		While (0 <> ptr[0])

			If TRUE = fStr then	'文字列中
				If Asc(Ex"\q") = ptr[0] then fStr = FALSE

			Else	'文字列外
				Select case ptr[0]
				Case Asc(Ex"\q")
					If 0 = init then init = ptr
					If TRUE = fField then fStr = TRUE

				Case Asc("<")
					If 0 <> init then AddTaken(init, (ptr - init) As Long, taken): init = 0

					If Asc("/") = ptr[1] then
						AddTaken("</", 2, taken)
						ptr += 1
					Else
						AddTaken("<", 1, taken)
					End If

					fField = TRUE

				Case Asc(">")
					If 0 <> init then AddTaken(init, (ptr - init) As Long, taken): init = 0

					AddTaken(">", 1, taken)

					fField = FALSE

				Case Asc("/")
					If Asc(">") = ptr[1] then

						If 0 <> init then AddTaken(init, (ptr - init) As Long, taken): init = 0

						AddTaken("/>", 2, taken)
						ptr += 1

						fField = FALSE
					End If

				Case Asc(" ")
					If 0 <> init then AddTaken(init, (ptr - init) As Long, taken): init = 0

				Case Else
					If 0 = init then init = ptr

				End Select
			End If

			ptr += 1
		Wend

		If 0 <> init then AddTaken(init, (ptr - init) As Long, taken): init = 0

	End Sub


	Private '////////  解析したトークンをキューに格納する  ////////
	Sub AddTaken(Str As BytePtr, Length As Long, Taken As *cQueue)
		Dim mem As BytePtr
		mem = calloc(Length+1)
		memcpy(mem, Str, Length)
		Taken->Enqueue(mem)
	End Sub



	'***********************************************************
	'    構文解析（トークンを解析）
	'***********************************************************


	Private '////////  トークンからデータを構築  ////////
	Function Parser(Parent As *iXmlElement, taken As *cQueue) As Long'(T/F)

		Dim mem As BytePtr
		Dim child As *iXmlElement
		Dim flag As PARSERINFO


		flag = ROOT
		While ( (0 <> taken->GetSize()) and (ERROR <> flag) and (NESTOUT <> flag) )

			'トークンを取り出し
			mem = taken->Dequeue()

			'デバッグコード
			'OutputFmtString(Ex"[%0d] %s\r\n", flag, mem)

			Select case 0
			Case lstrcmp(mem, "<")
				Select case flag
				Case ROOT:		flag = INITCHILD
				Case INITCHILD:	flag = ERROR
				Case ATTRIBUTE:	flag = ERROR
				Case VALUE:		flag = ERROR
				Case ENDVALUE:	flag = ERROR
				Case ENDCHILD:	flag = ERROR
				Case FINISH:	flag = ERROR
				End Select

			Case lstrcmp(mem, "</")
				Select case flag
				Case ROOT:		flag = ERROR
				Case INITCHILD:	flag = ERROR
				Case ATTRIBUTE:	flag = ERROR
				Case VALUE:		flag = ENDCHILD
				Case ENDVALUE:	flag = ENDCHILD
				Case ENDCHILD:	flag = ERROR
				Case FINISH:	flag = ERROR
				End Select

			Case lstrcmp(mem, ">")
				Select case flag
				Case ROOT:		flag = ERROR
				Case INITCHILD:	flag = ERROR
				Case ATTRIBUTE
					If TRUE = HasChild(taken) then	'孫要素があれば再帰処理
						If FALSE = Parser(child, taken) then flag = ERROR Else flag = ENDVALUE
					Else	'孫要素がなければ値の設定モード
						flag = VALUE
					End If
				Case VALUE:		flag = ERROR
				Case ENDVALUE:	flag = ERROR
				Case ENDCHILD:	flag = ERROR
				Case FINISH
					If TRUE = IsEndNest(taken) then	'孫要素がなければ再帰処理から復帰
						flag = NESTOUT
					Else	'処理が終了した子要素を解放
						flag = ROOT: Parent->ReleaseChild(child): child = 0
					End If
				End Select

			Case lstrcmp(mem, "/>")
				Select case flag
				Case ROOT:		flag = ERROR
				Case INITCHILD:	flag = ERROR
				Case ATTRIBUTE:	flag = ROOT: Parent->ReleaseChild(child): child = 0	'処理終了の子要素を解放
				Case VALUE:		flag = ERROR
				Case ENDVALUE:	flag = ERROR
				Case ENDCHILD:	flag = ERROR
				Case FINISH:	flag = ERROR
				End Select

			Case Else
				Select case flag
				Case ROOT:		flag = ERROR
				Case INITCHILD:	flag = ATTRIBUTE: child = Parent->CreateChild(mem, TRUE)	'子要素を作成
				Case ATTRIBUTE:	If FALSE = AddAttribute(child, mem) then flag = ERROR		'子要素の属性設定
				Case VALUE:		child->SetValue(mem): flag = ENDVALUE						'子要素の値設定
				Case ENDVALUE:	flag = ERROR
				Case ENDCHILD:	If 0 <> lstrcmp(mem, child->GetName()) then flag = ERROR Else flag = FINISH	'閉じるタグの確認
				Case FINISH:	flag = ERROR
				End Select

			End Select

			'取り出したトークンを解放
			free(mem)
		Wend

		'エラーの場合
		If flag = ERROR then return FALSE

		'成功の場合
		return TRUE
	End Function


	Private '////////  次のトークンが子要素を表すか判定  ////////
	Function HasChild(taken As *cQueue) As Long'(T/F)
		Dim ptr As BytePtr
		ptr = taken->PeekEx(0)
		If 0 = ptr then return FALSE
		If ( (Asc("<")=ptr[0]) and (Asc("/")<>ptr[1]) ) then return TRUE
		return FALSE
	End Function


	Private '////////  ネスト構造のラスト(再帰の復帰)を判定  ////////
	Function IsEndNest(taken As *cQueue) As Long'(T/F)
		Dim ptr As BytePtr
		ptr = taken->PeekEx(0)
		If 0 = ptr then return FALSE
		If 0 = lstrcmp("</", ptr) then return TRUE
		return FALSE
	End Function


	Private '////////  「key="param"」の文字列を解析してAttributeに追加する  ////////
	Function AddAttribute(Current As *iXmlElement, Str As BytePtr) As Long'(T/F)
		'＜注＞ Strが示す文字列の1部はヌル文字に置換される

		Dim key As BytePtr, param As BytePtr
		Dim ptr As BytePtr, chk As Long

		ptr = Str: chk = 0
		While (0 <> ptr[0])

			Select case ptr[0]
			Case Asc("=")
				Select case chk
				Case 0: key = Str: ptr[0] = 0: chk = 1
				Case 1: return FALSE
				Case 2: 'none
				Case 3: return FALSE
				End Select

			Case Asc(Ex"\q")
				Select case chk
				Case 0: return FALSE
				Case 1: param = ptr+1: chk = 2
				Case 2: ptr[0] = 0: chk = 3
				Case 3: return FALSE
				End Select

			Case Else
				Select case chk
				Case 0: 'none
				Case 1: return FALSE
				Case 2: 'none
				Case 3: return FALSE
				End Select

			End Select

			ptr += 1
		Wend

		If 3 <> chk then return FALSE

		return Current->CreateAttribute(key, param)
	End Function


End Class

[5] 内部で使用している独自クラス（追記）

[ここをクリックすると内容が表示されます]

コード: 全て選択

'###############################
'    ファイルIOクラス
'###############################

Class cFile: Inherits cFile_base

	'Private: hFile As HANDLE

	Public
	Sub cFile(hFILE As HANDLE)
		this.hFile = hFILE
	End Sub

End Class


Class cFile_base: Inherits cFile_Std

	Protected: hFile As HANDLE



	Public '////////  ファイルの作成  ////////
	Function Create(lpFileName As BytePtr, dwDesiredAccess As DWord, dwShareMode As DWord, fAlways As Long, fInherits As Long) As Long'(T/F)

		Dim security As SECURITY_ATTRIBUTES
		ZeroMemory(VarPtr(security), SizeOf(SECURITY_ATTRIBUTES))
		security.nLength = SizeOf(SECURITY_ATTRIBUTES)
		security.bInheritHandle = fInherits


		Dim dwCreationDisposition As DWord
		dwCreationDisposition = CREATE_NEW
		If TRUE = fAlways then dwCreationDisposition = CREATE_ALWAYS


		hFile = CreateFile(lpFileName, dwDesiredAccess, dwShareMode, security, dwCreationDisposition, FILE_ATTRIBUTE_NORMAL, 0)
		If INVALID_HANDLE_VALUE = hFile then return FALSE

		return TRUE
	End Function


	Public '////////  ファイルの作成  ////////
	Function Open(lpFileName As BytePtr, dwDesiredAccess As DWord, dwShareMode As DWord, fAlways As Long, fInherits As Long) As Long'(T/F)

		Dim security As SECURITY_ATTRIBUTES
		ZeroMemory(VarPtr(security), SizeOf(SECURITY_ATTRIBUTES))
		security.nLength = SizeOf(SECURITY_ATTRIBUTES)
		security.bInheritHandle = fInherits


		Dim dwCreationDisposition As DWord
		dwCreationDisposition = OPEN_EXISTING
		If TRUE = fAlways then dwCreationDisposition = OPEN_ALWAYS


		hFile = CreateFile(lpFileName, dwDesiredAccess, dwShareMode, security, dwCreationDisposition, FILE_ATTRIBUTE_NORMAL, 0)
		If INVALID_HANDLE_VALUE = hFile then return FALSE

		return TRUE
	End Function


	Public '////////  ファイルのクローズ  ////////
	Function Close() As Long'(T/F)
		return CloseHandle(hFile)
	End Function


	Public
	Function Write(Data As VoidPtr, Size As DWord) As Long'(T/F)
		Dim written[0] As DWord
		return WriteFile(hFile, Data, Size, written, ByVal 0)
	End Function


	Public
	Function Read(Size As DWord) As VoidPtr'(ptr/0)
		Dim mem As VoidPtr, readed[0] As DWord
		mem = MemUpdate(Size+1) '文字列の場合を考慮
		If FALSE = ReadFile(hFile, mem, Size, readed, ByVal 0) then return 0
		return mem
	End Function


	Public '////////  ファイルのサイズを取得  ////////
	Function GetSize() As DWord
		return GetFileSize(hFile, 0)
	End Function


	Public
	Function SetEnd() As Long'(T/F)
		If 0 = SetEndOfFile(hFile) then return FALSE
		return TRUE
	End Function


	Public
	Function SetPointer(lDistanceToMove As Long, dwMoveMethod As DWord) As VoidPtr'(ptr/-1)
		return SetFilePointer(hFile, lDistanceToMove, 0, dwMoveMethod)
	End Function


End Class



Class cFile_Std

	Private: _mem As VoidPtr

	Public
	Sub cFile_Std()
		_mem = 0
	End Sub
	Sub ~cFile_Std()
		free(_mem)
	End Sub

	Protected
	Function MemUpdate(size As DWord) As VoidPtr
		free(_mem)
		_mem = calloc(size)
		return _mem
	End Function

End Class





'###############################
'    キュークラス
'###############################

#ifndef _INC_CL_QUEUE
#define _INC_CL_QUEUE


'////////  構造体  ////////
Type QUEUE_DATA
	Data As VoidPtr
	lpNext As *QUEUE_DATA
End Type
Type QUEUE_LIST
	root As QUEUE_DATA
	last As *QUEUE_DATA
	peekptr As *QUEUE_DATA
End Type



'////////  インターフェース  ////////
Interface iQueue
	Sub Enqueue(data As VoidPtr)
	Function Dequeue() As VoidPtr '(ptr/0)
	Function Peek() As VoidPtr '(ptr/0)
	Function PeekIsEnd() As Long '(T/F)
	Sub PeekReset()
	Function PeekEx(index As DWord) As VoidPtr '(ptr/0)
	Function GetSize() As DWord
End Interface



'////////  クラス  ////////
Class cQueue: Inherits iQueue

	Private: qu As QUEUE_LIST
	Private: total As *DWord


	Public '////////  コンストラクタ  ////////
	Sub cQueue()
		ZeroMemory(VarPtr(qu), SizeOf(QUEUE_LIST))
		total = VarPtr(qu.root.Data)
	End Sub


	Public '////////  デストラクタ  ////////
	Sub ~cQueue()

		Dim lpDel As *QUEUE_DATA, lpNext As *QUEUE_DATA

		If 0 = total[0] then return

		lpNext = qu.root.lpNext
		While (0 <> lpNext)
			lpDel = lpNext
			lpNext = lpDel->lpNext
			free(lpDel)
		Wend

	End Sub


	Public '////////  データの追加  ////////
	Override _
	Sub Enqueue(data As VoidPtr)

		Dim NewData As *QUEUE_DATA

		'メモリ確保＋データ格納
		NewData = calloc(SizeOf(QUEUE_DATA))
		NewData->Data = data

		'リストに追加
		If 0 = total[0] then
			qu.root.lpNext = NewData
		Else
			qu.last->lpNext = NewData
		End If

		'最後のデータとして登録
		qu.last = NewData

		'データの総数を更新する
		total[0] += 1

	End Sub


	Public '////////  データの取り出し  ////////
	Override _
	Function Dequeue() As VoidPtr '(ptr/0)

		'リストが空なら何もしない
		If 0 = total[0] then return 0

		Dim data As *QUEUE_DATA

		'取り出すデータを選択
		data = qu.root.lpNext

		'取り出すデータをリストから削除
		qu.root.lpNext = data->lpNext
		total[0] -= 1

		'データを取り出し、メモリを解放する
		Dequeue = data->Data
		free(data)

	End Function


	Public '////////  ピーク処理  ////////
	Override _
	Function Peek() As VoidPtr '(ptr/0)

		'リストが空なら何もしない
		If 0 = total[0] then return 0

		'選択されていなければ何もしない
		If 0 = qu.peekptr then return 0

		'データを参照する
		Peek = qu.peekptr->Data

		'次のデータを選択する
		qu.peekptr = qu.peekptr->lpNext

	End Function


	Public '////////  ピーク処理の終了判定  ////////
	Override _
	Function PeekIsEnd() As Long '(T/F)
		'Peekが最後まで走査していればTRUEを返す
		If 0 = qu.peekptr then return TRUE
		return FALSE
	End Function


	Public '////////  ピーク処理の初期化  ////////
	Override _
	Sub PeekReset()
		'一番古いデータを選択する
		qu.peekptr = qu.root.lpNext
	End Sub


	Public '////////  拡張ピーク処理  ////////
	Override _
	Function PeekEx(index As DWord) As VoidPtr '(ptr/0)

		'リストが空なら何もしない
		If 0 = total[0] then return 0

		Dim data As *QUEUE_DATA, ctr As DWord

		'データを走査する
		data = qu.root.lpNext
		For ctr = 1 to index
			data = data->lpNext
			If 0 = data then return 0
		Next

		return data->Data
	End Function


	Public '////////  データの総数を取得  ////////
	Override _
	Function GetSize() As DWord
		GetSize = total[0]
	End Function

End Class


#endif '_INC_CL_QUEUE

使い方

[ここをクリックすると内容が表示されます]

XMLファイルクラスの方は出来たばかりなので、まだバグがあるかもしれません。
特に構文解析などの部分はゴリ押しで書いたので、おかしなところがありそうです。

＜投票について＞
どの程度の方がこのクラスを使ってくださるかわかりませんが、
使う際に投票していただけるとうれしいです。（自分のやる気がでますｗ）

＜今後実践コードモジュールにトピックを立てる方へ＞
投稿したコードがどの程度皆さんに使われるか知りたくありませんか？
投票が雑談所以外ではあまり使われていないようなのでこうやってもっと使っていきましょう！

今はこのテキストを書くのに疲れてしまったので、ソースの整合（インデントの統一など）はまた後日にでもやります。
＜追記＞
・XMLファイルクラス内で独自のファイルクラスとキュークラスを使用していたので、追加しました。
・XMLファイルクラスに注意事項を付加しました。

ab.com コミュニティ

設定ファイルクラス2種(ini＋XML)

設定ファイルクラス2種(ini＋XML)