ab.com コミュニティ https://www.activebasic.com/forum/ |
|
設定ファイルクラス2種(ini+XML) https://www.activebasic.com/forum/viewtopic.php?t=2347 |
ページ 1 / 1 |
作成者: | のぶあや [ 2008年3月25日(火) 22:18 ] |
記事の件名: | 設定ファイルクラス2種(ini+XML) |
設定ファイルとして使われている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 使い方 [ここをクリックすると内容が表示されます] 引用: [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 使い方 [ここをクリックすると内容が表示されます] 引用: [1] 「cXmlElement」クラスのオブジェクトを生成する。(コンストラクタの引数は「0」) このとき変数は「iXmlElement」で宣言。(「cXmlElement」だと、要素名を変更するメンバ関数が存在する為) [2] XMLファイルを読み込む場合はこの時点でLoad関数を呼び出す。 構文エラーの場合は、それ以前の部分のみデータが構築され、不完全な状態となるが、 アルゴリズム上、メモリリークは発生しない(ハズ)。 [4] 要素名、属性、値、子要素などに対する操作を行う<注意> [5] オブジェクトを破棄する <注意事項> ・ 要素名、属性、値に対するメンバ関数の内、戻り値がポインタを指している場合、 そのポインタが指すメモリはクラス内部で解放されるので、必要に応じてコピーをとっておく。 ・ 子要素に対するメンバ関数の内、戻り値がオブジェクトを指している場合は、「ReleaseChild」関数によって解放しなければならない。 ただし、「CreateChild」関数は引数の「CreateObj」に「TRUE」を指定した場合にのみ オブジェクトが生成されるので、その場合のみ前述の方法によって解放しなければならない。 (TRUEを指定しなかった場合は「0」が返される。) ・ 「Enum~」となっている関数は引数にTRUEを指定することで1つ目のデータを取得できる。(列挙の初期化) 続けてデータを列挙する場合はFALSEを指定する。全ての列挙が完了すると関数は「0」を返す。 XMLファイルクラスの方は出来たばかりなので、まだバグがあるかもしれません。 特に構文解析などの部分はゴリ押しで書いたので、おかしなところがありそうです。 <投票について> どの程度の方がこのクラスを使ってくださるかわかりませんが、 使う際に投票していただけるとうれしいです。(自分のやる気がでますw) <今後実践コードモジュールにトピックを立てる方へ> 投稿したコードがどの程度皆さんに使われるか知りたくありませんか? 投票が雑談所以外ではあまり使われていないようなのでこうやってもっと使っていきましょう! 今はこのテキストを書くのに疲れてしまったので、ソースの整合(インデントの統一など)はまた後日にでもやります。 <追記> ・XMLファイルクラス内で独自のファイルクラスとキュークラスを使用していたので、追加しました。 ・XMLファイルクラスに注意事項を付加しました。 |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |