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
使い方
[ここをクリックすると内容が表示されます]
Usage さんが書きました:[1] cPrivateProfileManagerのオブジェクトを生成する
コンストラクタの引数は「設定ファイルのパス」「整数値のデフォルト値」「文字列のデフォルト値」
「設定ファイルのパス」を省略（=0）すると実行ファイルと同名（拡張子がini）に設定される。デフォルト値の省略はできない。
[2] CreateObject関数の引数にセクション名を指定してセクションオブジェクト（iProfileSection）を作成する
[3] セクションオブジェクト（iProfileSection）を用いて整数値や文字列の読み書きや、キー、セクションの削除を行う
[4] DeleteObject関数を用いてセクションオブジェクトを破棄する
[5] cPrivateProfileManagerのオブジェクトを破棄する
XMLファイルクラス
＜注意事項＞
・XML文書の1行目に書かれているXML宣言は無視されます。出力にも宣言は含まれません。
・XMLはUnicodeがデフォルトだったと思いますが、これはシフトJIS専用です。
ソース
[ここをクリックすると内容が表示されます]
[1] インターフェース
[ここをクリックすると内容が表示されます]
[2] クラス内構造体
コード: 全て選択
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
[ここをクリックすると内容が表示されます]
[3] クラス（データ操作部分）
コード: 全て選択
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
[ここをクリックすると内容が表示されます]
[4] クラス（ファイルIO部分）
コード: 全て選択
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
[ここをクリックすると内容が表示されます]
[5] 内部で使用している独自クラス（追記）
コード: 全て選択
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
[ここをクリックすると内容が表示されます]
コード: 全て選択
'###############################
' ファイル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
使い方
[ここをクリックすると内容が表示されます]
Usage さんが書きました:[1] 「cXmlElement」クラスのオブジェクトを生成する。（コンストラクタの引数は「0」）
このとき変数は「iXmlElement」で宣言。（「cXmlElement」だと、要素名を変更するメンバ関数が存在する為）
[2] XMLファイルを読み込む場合はこの時点でLoad関数を呼び出す。
構文エラーの場合は、それ以前の部分のみデータが構築され、不完全な状態となるが、
アルゴリズム上、メモリリークは発生しない(ハズ)。
[4] 要素名、属性、値、子要素などに対する操作を行う＜注意＞
[5] オブジェクトを破棄する
＜注意事項＞
・ 要素名、属性、値に対するメンバ関数の内、戻り値がポインタを指している場合、
そのポインタが指すメモリはクラス内部で解放されるので、必要に応じてコピーをとっておく。
・ 子要素に対するメンバ関数の内、戻り値がオブジェクトを指している場合は、「ReleaseChild」関数によって解放しなければならない。
ただし、「CreateChild」関数は引数の「CreateObj」に「TRUE」を指定した場合にのみ
オブジェクトが生成されるので、その場合のみ前述の方法によって解放しなければならない。
（TRUEを指定しなかった場合は「0」が返される。）
・ 「Enum～」となっている関数は引数にTRUEを指定することで1つ目のデータを取得できる。(列挙の初期化)
続けてデータを列挙する場合はFALSEを指定する。全ての列挙が完了すると関数は「0」を返す。
XMLファイルクラスの方は出来たばかりなので、まだバグがあるかもしれません。
特に構文解析などの部分はゴリ押しで書いたので、おかしなところがありそうです。
＜投票について＞
どの程度の方がこのクラスを使ってくださるかわかりませんが、
使う際に投票していただけるとうれしいです。（自分のやる気がでますｗ）
＜今後実践コードモジュールにトピックを立てる方へ＞
投稿したコードがどの程度皆さんに使われるか知りたくありませんか？
投票が雑談所以外ではあまり使われていないようなのでこうやってもっと使っていきましょう！
今はこのテキストを書くのに疲れてしまったので、ソースの整合（インデントの統一など）はまた後日にでもやります。
＜追記＞
・XMLファイルクラス内で独自のファイルクラスとキュークラスを使用していたので、追加しました。
・XMLファイルクラスに注意事項を付加しました。