|
himXML (gesprochen himix ML)
Liste der Anhänge anzeigen (Anzahl: 3)
wollt eigentlich nur mal die ersten Fortschritte eines vor kurzem längerem begonnen Projektes vorstellen :angel:
es ist "nur" eine weitere kleine XML-Klasse. der Grund war eigentlich, daß mir andere XML-Projekte zu rießig sind und MSMXL (  TXMLDocument) nicht grad schnell. :shock:[info] aktuell entwickle ich unter D2009 und direkt kompatibel düfte es bis Delphi 2006 / Turbo Delphi sein und Aufgrund einiger Anfragen versuch ich, sobald es da "gut" läuft, eine Extraversion weiter abwärtskompatibel zu machen ... mal sehn, bis wie weit runter das geht [/info] [add 04.01.2001] aktuell sieht es so aus, als wenn es schonmal bis zu D7 läuft [add/] aktueller Post:  http://www.delphipraxis.net/internal...116416#1116416 #193
ansonsten bin ich für Tipps und Vorschläge dankbar :angel2: [add 13.03.2009] ach ja falls der Name jemandem nich gefällt ... Beschwerden bitte an Matze richten :mrgreen: [add] im Beitrag #193 wird etwas über die im Download mit enthalenen anderen XML-Libs geschrieben.[add] Achtung, beim Forenupgrad der DP sind die Dateikommentare verschwunden und die Dateinamen sind unglücklich importiert wurden. himxml_246.7z = v0.9 21.05.2009 himxml_164.7z = v0.99d 12.01.2010 other.7z = 30.12.2010 (only the "other" directory) |
Re: himXML (gesprochen himixML)
hab jetzt das Speichern überarbeitet:
Delphi-Quellcode:
Mit den vorherrigen Werten ist das nicht direkt vergleichbar, da dieses hier ein anderer/älterer PC ist.
// 10.000
create:16 fill:10453 save: 94 free: 31 create: 0 fill: 31 save:110 free:171 // 100.000 (neue Speicherroutine) create:16 fill:1016359 save: 359 free: 188 create: 0 fill: 187 save: 9141 free:6844 // 100.000 (alte Speicherroutine) create: 0 fill: 171 save:14532 free:6812 Im Vergleich zur alten Speicherroutine isses wohl knapp ein Drittel schneller. Aber ich denk die 180 KB/s sollten sich noch verbessern lassen (wenn ich Zeit finde muß ich mal sehn wo es da hängt). Was mir aber grad noch aufgefallen ist: bei mir 16 MB maximaler Speicher (RAM) mit MSXML gleich mal schlappe 139 MB (laut Taskmanager) Hab jetzt kein noch Update der Dateien gemacht ... ist ja nicht viel passiert. Und wenn ich dann am Montag zurückkomm werd' ich mich erstmal mit'm Parsen und anderen Dingen beschäftigen. |
Re: himXML (gesprochen himixML)
schade, dass es nicht D3-Kompatibel ist :(, hab bisher noch keine Funktionierende XML-Implementation für D3 gefunden.
vielleicht hast ja lust das mit einzubauen. ein einfacher XML-Parser würde mir ja reichen :D bevor jetzt Kommentare á la "wer nimmt schon sowas altes" oder "dann nimm alt ein neueres" kommen...ich nehme hauptsächlich D3, weil ich in der Zeit zwischen Klicken auf das Delphi-Icon und anfangen zu programmieren nicht erst kaffee kochen will ;) und für kleinere Projekte reicht D3 völlig aus. da braucht man die Funktionen, die die neuen IDEs/VCL unterstützen nicht wirklich. Gruß Frank |
Re: himXML (gesprochen himixML)
Wenn es dann läuft kann ich ja mal nachsehn was sich machen läßt.
Muß nur erstmal rausbekommen was alles nicht in D3 vorhanden ist. - Operatoren und Class-Prozeduren müssen raus - Strict Private gibt's auch nicht - gingen Klassenvariablen? ich glaub nicht, oder?
Delphi-Quellcode:
- WideString gab's aber schon?
TXMLFile = Class
Private Class Var __DefaultTextIndent: TWideString; __DefaultLineFeed: TWideString; __DefaultValueSeperator: TWideString; __DefaultValueQuotation: TWideString; Class Procedure SetDefaultTextIndent (Const Value: WideString); Static; Class Procedure SetDefaultLineFeed (Const Value: WideString); Static; Class Procedure SetDefaultValueSeperator(Const Value: WideString); Static; Class Procedure SetDefaultValueQuotation(Const Value: WideString); Static; End; - mit dynamischen Array's gab's doch auch Probleme? :gruebel: |
Re: himXML (gesprochen himixML)
widestring gibt es,class selbst gabs nur als schlüsselwort bei der typzuweisung, also nicht für operatoren/Variablen/methoden/etc.
was es sonst nicht gibt: overload, dynamische arrays ;) Gruß Frank |
Re: himXML (gesprochen himixML)
so, ich hab inzwischen mal die Definition etwas überarbeitet ...
Delphi-Quellcode:
der öffentliche Teil sieht also sozusagen nun so aus:
Unit himXML;
// EXMLException type of exceptions that create by this classes // // TXMLFile root class // DefaultOptions see TXMLOptions // DefaultTextIndent only ' ' or #9 // DefaultLineFeed only #13 and/or #10 // DefaultValueSeperator '=' and ' ' // DefaultValueQuotation '"' or '''' // // Owner user definied value (TObject) not used in this component // // Create parameter: see at .Owner // Free - // // Options see .DefaultOptions or use XMLUseDefaultOptions // TextIndent see .DefaultTextIndent or use XMLUseDefault // LineFeed see .DefaultLineFeed or use XMLUseDefault // ValueSeperator see .DefaultValueSeperator or use XMLUseDefault // ValueQuotation see .DefaultValueQuotation or use XMLUseDefault // // FileName file of file from that loadet the xml-data (.LoadFromFile) or to use for auto save (xoAutoSaveOnClose) // LoadFromFile - // SaveToFile - // LoadFromStream - // SaveToStream - // LoadFromXML - // SaveToXML - // asXML see at .LoadFromXML and .SaveToXML // Clear delete all data and create a new file <?xml version="1.0" encoding="UTF-8" standalone="yes" ?><xml /> // // Version - // Encoding - // Standalone - // // Nodes - // RootNode access to the root node <abc /> of the xml file // // OnNodeChange see TMXLNodeChangeEvent for states // OnStatus see TXMLFileStatusEvent for states // // _Lock is not used by this class // _TryLock you can it use to make this class threadsave: // _Unlock xml._Lock; try ... finally xml._Unlock; end; // _isLocked if xml._TryLock then try ... finally xml._Unlock; end; // // TXMLNodeList list of nodes (sub nodes) // Owner - // Parent - // // Create - // Free - // // FirstNode FirstNodeNF - // // Count CountNF - // Node NodeNF - // // Add - // Insert InsertNF - // Remove RemoveNF - // Delete DeleteNF - // Clear - // // IndexOf IndexOfNF - // Exists ExistsNF - // // CloneNode - // CloneNodes - // // Assign - // // Sort see NodeSortProc // // TXMLNode node // Owner - // Parent - // ParentList - // // Create - // Free - // // Index IndexNF - // Level - // // NodeType - // // Name - // Namespace get the namespace of .Name // NameOnly get the name without namespace // // Attributes - // // Data - // Data_Base64 - // XMLData - // // isTextNode - // hasCDATA - // asCDATA - // // Nodes - // // Attribute see at TXMLAttributes(.Attributes).Value // Node see at TXMLNodeList(.Nodes).Node // NodeNF see at TXMLNodeList(.Nodes).NodeNF // AddNode see at TXMLNodeList(.Nodes).Add // // NextNode NextNodeNF - // // TXMLAttributes list of node attributes // Owner - // Parent - // // Create - // Free - // // Count - // Name - // Namespace get the namespace of .Name // NameOnly get the name without namespace // Value - // // Add - // Insert - // Delete - // Clear - // // IndexOf - // Exists - // // CloneAttr - // // Assign - // // Sort see AttributeSortProc // // TXMLOptions - // xoChangeInvalidChars, - // xoAllowUnknownData, - // xoDontNormalizeText, - // xoHideInstructionNodes don't show nodes with .NodeType=xtInstruction // xoHideTypedefNodes don't show nodes with .NodeType=xtTypedef // xoHideCDataNodes don't show nodes with .NodeType=xtCData // xoHideCommentNodes don't show nodes with .NodeType=xtComment // xoHideUnknownNodes don't show nodes with .NodeType=xtUnknown // xoNodeAutoCreate - // xoNodeAutoIndent - // xoAutoSaveOnClose - // xoFullEmptyElements - // // TXMLEncoding - // xeUTF7 UTF-7 Universal Alphabet (7 bit Unicode-Transformation-Format-codierung) // xeUTF8 UTF-8 Universal Alphabet (8 bit Unicode-Transformation-Format-codierung) // //xeUTF16 UTF-16 Universal Alphabet (16 bit Unicode-Transformation-Format-codierung) // xeUnicode ISO-10646-UCS-2 Universal Alphabet (little endian 2 byte Unicode) // xeUnicodeBE Universal Alphabet (big endian 2 byte Unicode) // xeIso8859_1 ISO-8859-1 Western Alphabet (ISO) // xeIso8859_2 ISO-8859-2 Central European Alphabet (ISO) // xeIso8859_3 ISO-8859-3 Latin 3 Alphabet (ISO) // xeIso8859_4 ISO-8859-4 Baltic Alphabet (ISO) // xeIso8859_5 ISO-8859-5 Cyrillic Alphabet (ISO) // xeIso8859_6 ISO-8859-6 Arabic Alphabet (ISO) // xeIso8859_7 ISO-8859-7 Greek Alphabet (ISO) // xeIso8859_8 ISO-8859-8 Hebrew Alphabet (ISO) // xeIso8859_9 ISO-8859-9 Turkish Alphabet (ISO) // xeIso2022Jp ISO-2022-JP Japanese (JIS) // xeEucJp EUC-JP Japanese (EUC) // xeShiftJis SHIFT-JIS Japanese (Shift-JIS) // xeWindows1250 WINDOWS-1250 Central European Alphabet (Windows) // xeWindows1251 WINDOWS-1251 Cyrillic Alphabet (Windows) // xeWindows1252 WINDOWS-1252 Western Alphabet (Windows) // xeWindows1253 WINDOWS-1253 Greek Alphabet (Windows) // xeWindows1254 WINDOWS-1254 Turkish Alphabet (Windows) // xeWindows1255 WINDOWS-1255 Hebrew Alphabet (Windows) // xeWindows1256 WINDOWS-1256 Arabic Alphabet (Windows) // xeWindows1257 WINDOWS-1257 Baltic Alphabet (Windows) // xeWindows1258 WINDOWS-1258 Vietnamese Alphabet (Windows) // // TMXLNodeChangeEvent - // Node xml node to be changed // Typ = xcNodeTypeChanged - // xcNameChanged - // xcAttributesChanged - // xcDataChanged - // //xcChildNodesChanged - // xcAddetNode - // xcBeforeDeleteNode - // xcIndexChanged - // // TXMLFileStatusEvent - // XML - // Typ = xsLoad State = progress in percent // xsLoadEnd State = processed data size // xsSave State = saved data size // xsSaveEnd State = saved data size // xsBeforeSaveNode TXMLNode(State) = node to will be save // xsBeforeDestroy State = 0 // State see at Typ // // TXMLNodeType - // xtInstruction <?name attributes ?> // xtTypedef <!name data> or <!name data...[...data]> // xtElement <name attributes /> or <name attributes>data or elements</name> // xtCData (unnamed) <![CDATA[data]]> // xtComment (unnamed) // xtUnknown (unnamed) data // // NodeSortProc // Function SortProc(Node1, Node2: TXMLNode): TValueRelationship; // Begin // If {Node1} = {Node2} Then Result := 0 // Else If {Node1} < {Node2} Then Result := -1 // Else (*If {Node1} > {Node2} Then*) Result := 1; // End; // // AttributeSortProc // if SortProc ist nil, wenn the default sort procedure is used (sort by value name) // // Function SortProc(Attributes: TXMLAttributes; Index1, Index2: Integer): TValueRelationship; // Begin // If {Attributes[Index1]} = {Attributes[Index2]} Then Result := 0 // Else If {Attributes[Index1]} < {Attributes[Index2]} Then Result := -1 // Else (*If {Attributes[Index1]} > {Attributes[Index2]} Then*) Result := 1; // End; Interface Uses Windows, SysUtils, Classes, Types; {$IF Defined(UnicodeString) and (SizeOf(Char) = 2)} {$DEFINE XMLUnicodeString} {$ELSE} {$UNDEF XMLUnicodeString} {$IFEND} Const XMLFileBufferSize = 65536; Type TWideString = {$IFDEF XMLUnicodeString}UnicodeString{$ELSE}WideString{$ENDIF}; {***** forward definitions ********************************************************************} TXMLFile = Class; TXMLNode = Class; TXMLNodeList = Class; TXMLAttributes = Class; {***** open definitions ***********************************************************************} EXMLException = Class(Exception); TXMLOption = (xoChangeInvalidChars, xoAllowUnknownData, xoDontNormalizeText, xoHideInstructionNodes, xoHideTypedefNodes, xoHideCDataNodes, xoHideCommentNodes, xoHideUnknownNodes, xoNodeAutoCreate, xoNodeAutoIndent, xoAutoSaveOnClose, xoFullEmptyElements, xo_IgnoreEncoding, xo_useDefault); TXMLOptions = Set of TXMLOption; TXMLVersion = (xvXML10, xvXML11); TXMLEncoding = (xeUTF7, xeUTF8, {xeUTF16,} xeUnicode, xeUnicodeBE, xeIso8859_1, xeIso8859_2, xeIso8859_3, xeIso8859_4, xeIso8859_5, xeIso8859_6, xeIso8859_7, xeIso8859_8, xeIso8859_9, xeIso2022Jp, xeEucJp, xeShiftJis, xeWindows1250, xeWindows1251, xeWindows1252, xeWindows1253, xeWindows1254, xeWindows1255, xeWindows1256, xeWindows1257, xeWindows1258); TMXLNodeChangeType = (xcNodeTypeChanged, xcNameChanged, xcAttributesChanged, xcDataChanged, {xcChildNodesChanged,} xcAddetNode, xcBeforeDeleteNode, xcIndexChanged); TMXLNodeChangeEvent = Procedure(Node: TXMLNode; Typ: TMXLNodeChangeType) of Object; TXMLFileStatus = (xsLoad, xsLoadEnd, xsSave, xsSaveEnd, xsBeforeSaveNode, xsBeforeDestroy); TXMLFileStatusEvent = Procedure(XML: TXMLFile; Typ: TXMLFileStatus; State: Integer) of Object; TXMLNodeType = (xtInstruction, xtTypedef, xtElement, xtCData, xtComment, xtUnknown); TXMLNodeTypes = Set of TXMLNodeType; TXMLNodeSortProc = Function(Node1, Node2: TXMLNode): TValueRelationship; TXMLAttrSortProc = Function(Attributes: TXMLAttributes; Index1, Index2: Integer): TValueRelationship; {***** internal definitions *******************************************************************} TIndex = Record ValueType: (vtIntValue, vtStringValue); IntValue: Integer; StringValue: TWideString; Class Operator Implicit( Value: Integer): TIndex; Class Operator Implicit(Const Value: TWideString): TIndex; End; TXMLTempData = Record Private Function GetChar(Index: Integer): WideChar; Procedure SetChar(Index: Integer; C: WideChar); Public Str: TWideString; CharSize: RawByteString; Class Operator Implicit(Const Value: TXMLTempData): TWideString; Class Operator Implicit(Const Value: TWideString): TXMLTempData; Property Char[Index: Integer]: WideChar Read GetChar Write SetChar; Default; Function Length: Integer; End; TXMLWriteBuffer = Record Length: Integer; Data: Array[1..XMLFileBufferSize] of WideChar; End; TXMLAssembleOptions = Record Options: TXMLOptions; // default value = [xoHideInstructionNodes, xoHideTypedefNodes, xoHideCDataNodes, xoNodeAutoIndent]; TextIndent: TWideString; // default value = ' ' LineFeed: TWideString; // default value = #13#10 ValueSeperator: TWideString; // default value = '=' ValueQuotation: TWideString; // default value = '"' DoStatus: Procedure(Typ: TXMLFileStatus; State: Integer = 0) of Object; Version: TXMLVersion; // start value = cvXML10 or xvXML11 if Owner.Version="1.1" Encoding: TXMLEncoding; // start value = xeUTF8 or xeUnicode if Owner.Encoding="ISO-10646-UCS-2" TextOffset: Integer; // start value = 0 StreamStart: Int64; // start value = -1 Data: TXMLTempData; // start value = '', '' Buffer: TXMLWriteBuffer; // start value = .Length=0 End; TXMLCharCheckTyp = (xtChar, xtSpace, xtAlpha, xtAlphaNum, xtHex, {xtLetter,} xtNameStartChar, xtNameChar{, xtBaseChar, xtIdeographic, xtCombiningChar, xtDigit, xtExtender}); TXMLStringCheckTyp = (xtInstruction_NodeName, xtInstruction_VersionValue, xtInstruction_EncodingValue, xtInstruction_StandaloneValue, xtTypedef_NodeName, xtTypedef_Data, xtElement_NodeName, xtElement_Data, xtCData_Data, xtComment_Data, xtUnknown_Data, xtAttribute_Name, xtAttribute_InValue, xtAttribute_Value); {***** classes : root document ****************************************************************} TXMLFile = Class Strict Private Class Var __DefaultOptions: TXMLOptions; __DefaultTextIndent: TWideString; __DefaultLineFeed: TWideString; __DefaultValueSeperator: TWideString; __DefaultValueQuotation: TWideString; Class Procedure SetDefaultOptions ( Value: TXMLOptions); Static; Class Procedure SetDefaultTextIndent (Const Value: TWideString); Static; Class Procedure SetDefaultLineFeed (Const Value: TWideString); Static; Class Procedure SetDefaultValueSeperator(Const Value: TWideString); Static; Class Procedure SetDefaultValueQuotation(Const Value: TWideString); Static; Strict Private _Owner: TObject; _Options: TXMLOptions; _TextIndent: TWideString; _LineFeed: TWideString; _ValueSeperator: TWideString; _ValueQuotation: TWideString; _FileName: TWideString; _Nodes: TXMLNodeList; _OnNodeChange: TMXLNodeChangeEvent; _OnStatus: TXMLFileStatusEvent; _ThreadLock: TRTLCriticalSection; Procedure SetOptions ( Value: TXMLOptions); Procedure SetTextIndent (Const Value: TWideString); Procedure SetLineFeed (Const Value: TWideString); Procedure SetValueSeperator(Const Value: TWideString); Procedure SetValueQuotation(Const Value: TWideString); Procedure SetFileName (Const Value: TWideString); Function GetAsXML: AnsiString; Function GetXmlStyleNode: TXMLNode; Function GetVersion: TWideString; Procedure SetVersion (Const Value: TWideString); Function GetEncoding: TWideString; Procedure SetEncoding (Const Value: TWideString); Function GetStandalone: TWideString; Procedure SetStandalone (Const Value: TWideString); Procedure AssignNodes ( Nodes: TXMLNodeList); Function GetRootNode: TXMLNode; Public Class Property DefaultOptions: TXMLOptions Read __DefaultOptions Write SetDefaultOptions; Class Property DefaultTextIndent: TWideString Read __DefaultTextIndent Write SetDefaultTextIndent; Class Property DefaultLineFeed: TWideString Read __DefaultLineFeed Write SetDefaultLineFeed; Class Property DefaultValueSeperator: TWideString Read __DefaultValueSeperator Write SetDefaultValueSeperator; Class Property DefaultValueQuotation: TWideString Read __DefaultValueQuotation Write SetDefaultValueQuotation; Property Owner: TObject Read _Owner Write _Owner; Constructor Create(Owner: TObject = nil); Destructor Destroy; Override; Property Options: TXMLOptions Read _Options Write SetOptions; Property TextIndent: TWideString Read _TextIndent Write SetTextIndent; Property LineFeed: TWideString Read _LineFeed Write SetLineFeed; Property ValueSeperator: TWideString Read _ValueSeperator Write SetValueSeperator; Property ValueQuotation: TWideString Read _ValueQuotation Write SetValueQuotation; Property FileName: TWideString Read _FileName Write SetFileName; Procedure LoadFromFile (Const FileName: TWideString); Procedure SaveToFile (Const FileName: TWideString); Procedure LoadFromStream (Stream: TStream); Procedure SaveToStream (Stream: TStream); Procedure LoadFromXML (Const XMLString: AnsiString); Overload; Procedure LoadFromXML (Const XMLString: TWideString); Overload; Procedure SaveToXML (Var XMLString: AnsiString); Overload; Procedure SaveToXML (Var XMLString: TWideString); Overload; Property asXML: AnsiString Read GetAsXML Write LoadFromXML; Procedure Clear; Property Version: TWideString Read GetVersion Write SetVersion; Property Encoding: TWideString Read GetEncoding Write SetEncoding; Property Standalone: TWideString Read GetStandalone Write SetStandalone; Property Nodes: TXMLNodeList Read _Nodes Write AssignNodes; Property RootNode: TXMLNode Read GetRootNode; Property OnNodeChange: TMXLNodeChangeEvent Read _OnNodeChange Write _OnNodeChange; Property OnStatus: TXMLFileStatusEvent Read _OnStatus Write _OnStatus; Procedure _Lock; Function _TryLock: Boolean; Procedure _Unlock; Function _isLocked: Boolean; Private Class Function SameText (Const S1, S2: TWideString): Boolean; Class Function CompareText (Const S1, S2: TWideString): Integer; Class Function Trim (Const S: TWideString; RemoveAllSpaces: Boolean = False): TWideString; Class Function GetNoteTypeMask (Owner: TXMLFile = nil): TXMLNodeTypes; Class Function GetDefaultAssembleOptions(Owner: TXMLFile = nil): TXMLAssembleOptions; Class Function CheckChar ( C: WideChar; Typ: TXMLCharCheckTyp): Boolean; Class Function CheckString (Const S: TWideString; Typ: TXMLStringCheckTyp): Boolean; Class Function ConvertString(Const S: TWideString; Typ: TXMLStringCheckTyp): TWideString; Class Procedure ConvertToInternLineBreak (Var S: TWideString); Class Function ConvertToExternalLineBreak(Const S: TWideString; Const Options: TXMLAssembleOptions): TWideString; Class Function ReadBOM (Stream: TStream): TXMLEncoding; Class Procedure WriteBOM (Stream: TStream; FileEncoding: TXMLEncoding); Class Function ReadData (Stream: TStream; FileEncoding: TXMLEncoding; Var Data: TXMLTempData): Boolean; Class Procedure ClearTemp (Stream: TStream; Var Data: TXMLTempData); Class Procedure DeleteTemp ( Length: Integer; Var Data: TXMLTempData); Class Procedure WriteDataX (Stream: TStream; FileEncoding: TXMLEncoding; Data: PWideChar; DataLength: Integer); Class Procedure WriteData (Stream: TStream; FileEncoding: TXMLEncoding; Const Data: TWideString; Var Buffer: TXMLWriteBuffer); Class Procedure FlushData (Stream: TStream; FileEncoding: TXMLEncoding; Var Buffer: TXMLWriteBuffer); Class Procedure ParsingTree (Stream: TStream; Tree: TXMLNodeList; Var Options: TXMLAssembleOptions); Class Procedure AssembleTree (Stream: TStream; Tree: TXMLNodeList; Var Options: TXMLAssembleOptions); Procedure DoNodeChange (XML: TXMLNode; Typ: TMXLNodeChangeType); Procedure DoStatus (Typ: TXMLFileStatus; State: Integer = 0); End; {***** classes : node list ********************************************************************} TXMLNodeList = Class Strict Private _Owner: TXMLFile; _Parent: TXMLNode; _Nodes: packed Array of TXMLNode; Function GetNFFirstNode: TXMLNode; Function GetNFCount: Integer; Function GetNFNode (Const IndexOrName: TIndex): TXMLNode; Function GetFirstNode: TXMLNode; Function GetCount: Integer; Function GetNode ( Index: Integer): TXMLNode; Function GetNamedNode(Const Name: TWideString): TXMLNode; Private Procedure SetOwner(NewOwner: TXMLFile); Public Property Owner: TXMLFile Read _Owner; Property Parent: TXMLNode Read _Parent; Constructor Create(ParentOrOwner: TObject{TXMLNode, TXMLFile}); Destructor Destroy; Override; Property FirstNode: TXMLNode Read GetFirstNode; Property Count: Integer Read GetCount; Property Node [ Index: Integer]: TXMLNode Read GetNode; Default; Property Node [Const Name: TWideString]: TXMLNode Read GetNamedNode; Default; Function Add (Const Name: TWideString; NodeType: TXMLNodeType = xtElement): TXMLNode; Function Insert ( Node: TXMLNode; Index: Integer): TXMLNode; Overload; Function Insert (Const Name: TWideString; Index: Integer; NodeType: TXMLNodeType = xtElement): TXMLNode; Overload; Function Remove ( Node: TXMLNode): TXMLNode; Overload; Function Remove (Const Name: TWideString): TXMLNode; Overload; Function Remove ( Index: Integer): TXMLNode; Overload; Procedure Delete ( Node: TXMLNode); Overload; Procedure Delete (Const Name: TWideString); Overload; Procedure Delete ( Index: Integer); Overload; Procedure Clear; Function IndexOf ( Node: TXMLNode): Integer; Overload; Function IndexOf (Const Name: TWideString): Integer; Overload; Function Exists (Const Name: TWideString): Boolean; Function CloneNode ( Node: TXMLNode): TXMLNode; Procedure CloneNodes( Nodes: TXMLNodeList); Property FirstNodeNF: TXMLNode Read GetNFFirstNode; Property CountNF: Integer Read GetNFCount; Property NodeNF [Const IndexOrName: TIndex]: TXMLNode Read GetNFNode; Function InsertNF ( Node: TXMLNode; Index: Integer): TXMLNode; Overload; Function InsertNF (Const Name: TWideString; Index: Integer; NodeType: TXMLNodeType = xtElement): TXMLNode; Overload; Function RemoveNF ( Node: TXMLNode): TXMLNode; Overload; Function RemoveNF (Const Name: TWideString): TXMLNode; Overload; Function RemoveNF ( Index: Integer): TXMLNode; Overload; Procedure DeleteNF ( Node: TXMLNode); Overload; Procedure DeleteNF (Const Name: TWideString); Overload; Procedure DeleteNF ( Index: Integer); Overload; Function IndexOfNF ( Index: Integer): Integer; Overload; Function IndexOfNF ( Node: TXMLNode): Integer; Overload; Function IndexOfNF (Const Name: TWideString): Integer; Overload; Function ExistsNF (Const Name: TWideString): Boolean; Procedure Assign{NF}( Nodes: TXMLNodeList); Procedure Sort{NF} ( SortProc: TXMLNodeSortProc); Private Procedure DoNodeChange(XML: TXMLNode; Typ: TMXLNodeChangeType); End; {***** classes : node element *****************************************************************} TXMLNode = Class Private _Owner: TXMLFile; _Parent: TXMLNodeList; Strict Private _Type: TXMLNodeType; _Name: TWideString; _Attributes: TXMLAttributes; _Data: TWideString; _Nodes: TXMLNodeList; Function GetParent: TXMLNode; Function GetNFIndex: Integer; Function GetIndex: Integer; Function GetLevel: Integer; Procedure SetName (Const Value: TWideString); Function GetNamespace: TWideString; Procedure SetNamespace (Const Value: TWideString); Function GetNameOnly: TWideString; Procedure SetNameOnly (Const Value: TWideString); Procedure AssignAttributes( Attributes: TXMLAttributes); Function GetData: TWideString; Procedure SetData (Const Value: TWideString); Function GetBase64: TWideString; Procedure SetBase64 (Const Value: TWideString); Function GetXMLData: TWideString; Procedure SetXMLData (Const Value: TWideString); Procedure AssignNodes ( Nodes: TXMLNodeList); Function GetAttribute (Const IndexOrName: TIndex): TWideString; Procedure SetAttribute (Const IndexOrName: TIndex; Const Value: TWideString); Function GetNode (Const IndexOrName: TIndex): TXMLNode; Function GetNFNode (Const IndexOrName: TIndex): TXMLNode; Function GetNextNode: TXMLNode; Function GetNFNextNode: TXMLNode; Private Property RealData: TWideString Read _Data Write _Data; Procedure SetOwner(NewOwner: TXMLFile); Public Property Owner: TXMLFile Read _Owner; Property Parent: TXMLNode Read GetParent; Property ParentList: TXMLNodeList Read _Parent; Constructor Create(ParentOrOwner: TObject{TXMLNodeList, TXMLFile}; NodeType: TXMLNodeType = xtElement); Destructor Destroy; Override; Property IndexNF: Integer Read GetNFIndex; Property Index: Integer Read GetIndex; Property Level: Integer Read GetLevel; Property NodeType: TXMLNodeType Read _Type; Property Name: TWideString Read _Name Write SetName; Property Namespace: TWideString Read GetNamespace Write SetNamespace; Property NameOnly: TWideString Read GetNameOnly Write SetNameOnly; Property Attributes: TXMLAttributes Read _Attributes Write AssignAttributes; Property Data: TWideString Read GetData Write SetData; Property Data_Base64: TWideString Read GetBase64 Write SetBase64; Property XMLData: TWideString Read GetXMLData Write SetXMLData; Function isTextNode: Boolean; Function hasCDATA: Boolean; Procedure asCDATA(yes: Boolean); Property Nodes: TXMLNodeList Read _Nodes Write AssignNodes; Property Attribute [Const IndexOrName: TIndex]: TWideString Read GetAttribute Write SetAttribute; Property Node [Const IndexOrName: TIndex]: TXMLNode Read GetNode; Property NodeNF [Const IndexOrName: TIndex]: TXMLNode Read GetNFNode; Function AddNode (Const Name: TWideString; NodeType: TXMLNodeType = xtElement): TXMLNode; Property NextNode: TXMLNode Read GetNextNode; Property NextNodeNF: TXMLNode Read GetNFNextNode; Private Procedure DoNodeChange(Typ: TMXLNodeChangeType); End; {***** classes : list of node attributes ******************************************************} TXMLAttributes = Class Private Type TAttributes = Record Name, Value: TWideString; End; Strict Private _Owner: TXMLFile; _Parent: TXMLNode; _Attributes: packed Array of TAttributes; Function GetCount: Integer; Function GetName ( Index: Integer): TWideString; Procedure SetName ( Index: Integer; Const Value: TWideString); Function GetNamespace ( Index: Integer): TWideString; Procedure SetNamespace ( Index: Integer; Const Value: TWideString); Function GetNameOnly ( Index: Integer): TWideString; Procedure SetNameOnly ( Index: Integer; Const Value: TWideString); Function GetValue ( Index: Integer): TWideString; Procedure SetValue ( Index: Integer; Const Value: TWideString); Function GetNamedValue(Const Name: TWideString): TWideString; Procedure SetNamedValue(Const Name: TWideString; Const Value: TWideString); Private Procedure SetOwner(NewOwner: TXMLFile); Public Property Owner: TXMLFile Read _Owner; Property Parent: TXMLNode Read _Parent; Constructor Create(Parent: TXMLNode); Destructor Destroy; Override; Property Count: Integer Read GetCount; Property Name [ Index: Integer]: TWideString Read GetName Write SetName; Property Namespace[ Index: Integer]: TWideString Read GetNamespace Write SetNamespace; Property NameOnly [ Index: Integer]: TWideString Read GetNameOnly Write SetNameOnly; Property Value [ Index: Integer]: TWideString Read GetValue Write SetValue; Default; Property Value [Const Name: TWideString]: TWideString Read GetNamedValue Write SetNamedValue; Default; Function Add (Const Name: TWideString; Const Value: TWideString = ''): Integer; Function Insert (Const Name: TWideString; Index: Integer; Const Value: TWideString = ''): Integer; Procedure Delete (Const Name: TWideString); Overload; Procedure Delete ( Index: Integer); Overload; Procedure Clear; Function IndexOf (Const Name: TWideString): Integer; Function Exists (Const Name: TWideString): Boolean; Procedure CloneAttr( Attributes: TXMLAttributes); Procedure Assign ( Attributes: TXMLAttributes); Procedure Sort ( SortProc: TXMLAttrSortProc = nil); Private Procedure DoNodeChange; End; {***** constants ******************************************************************************} Const XMLUseDefault = '<default>'; // TXMLFile.FileTextIndent, TXMLFile.FileLineFeed and TXMLFile.AttrValueSep XMLUseDefaultOptions: TXMLOptions = [xo_useDefault]; // TXMLFile.Options Implementation ...
Delphi-Quellcode:
in Bezug auf
Unit himXML;
Interface Uses Windows, SysUtils, Classes, Types; Const XMLFileBufferSize = 65536; Type {***** forward definitions ********************************************************************} TXMLFile = Class; TXMLNode = Class; TXMLNodeList = Class; TXMLAttributes = Class; {***** open definitions ***********************************************************************} EXMLException = Class(Exception); TXMLOption = (xoChangeInvalidChars, xoAllowUnknownData, xoDontNormalizeText, xoHideInstructionNodes, xoHideTypedefNodes, xoHideCDataNodes, xoHideCommentNodes, xoHideUnknownNodes, xoNodeAutoCreate, xoNodeAutoIndent, xoAutoSaveOnClose, xoFullEmptyElements, xo_IgnoreEncoding, xo_useDefault); TXMLOptions = Set of TXMLOption; TXMLVersion = (xvXML10, xvXML11); TXMLEncoding = (xeUTF7, xeUTF8, {xeUTF16,} xeUnicode, xeUnicodeBE, xeIso8859_1, xeIso8859_2, xeIso8859_3, xeIso8859_4, xeIso8859_5, xeIso8859_6, xeIso8859_7, xeIso8859_8, xeIso8859_9, xeIso2022Jp, xeEucJp, xeShiftJis, xeWindows1250, xeWindows1251, xeWindows1252, xeWindows1253, xeWindows1254, xeWindows1255, xeWindows1256, xeWindows1257, xeWindows1258); TMXLNodeChangeType = (xcNodeTypeChanged, xcNameChanged, xcAttributesChanged, xcDataChanged, {xcChildNodesChanged,} xcAddetNode, xcBeforeDeleteNode, xcIndexChanged); TMXLNodeChangeEvent = Procedure(Node: TXMLNode; Typ: TMXLNodeChangeType) of Object; TXMLFileStatus = (xsLoad, xsLoadEnd, xsSave, xsSaveEnd, xsBeforeSaveNode, xsBeforeDestroy); TXMLFileStatusEvent = Procedure(XML: TXMLFile; Typ: TXMLFileStatus; State: Integer) of Object; TXMLNodeType = (xtInstruction, xtTypedef, xtElement, xtCData, xtComment, xtUnknown); TXMLNodeTypes = Set of TXMLNodeType; TXMLNodeSortProc = Function(Node1, Node2: TXMLNode): TValueRelationship; TXMLAttrSortProc = Function(Attributes: TXMLAttributes; Index1, Index2: Integer): TValueRelationship; {***** internal definitions *******************************************************************} TIndex = Record ValueType: (vtIntValue, vtStringValue); IntValue: Integer; StringValue: WideString; Class Operator Implicit( Value: Integer): TIndex; Class Operator Implicit(Const Value: WideString): TIndex; End; {***** classes : root document ****************************************************************} TXMLFile = Class Class Property DefaultOptions: TXMLOptions Read __DefaultOptions Write SetDefaultOptions; Class Property DefaultTextIndent: WideString Read __DefaultTextIndent Write SetDefaultTextIndent; Class Property DefaultLineFeed: WideString Read __DefaultLineFeed Write SetDefaultLineFeed; Class Property DefaultValueSeperator: WideString Read __DefaultValueSeperator Write SetDefaultValueSeperator; Class Property DefaultValueQuotation: WideString Read __DefaultValueQuotation Write SetDefaultValueQuotation; Property Owner: TObject Read _Owner Write _Owner; Constructor Create(Owner: TObject = nil); Destructor Destroy; Override; Property Options: TXMLOptions Read _Options Write SetOptions; Property TextIndent: WideString Read _TextIndent Write SetTextIndent; Property LineFeed: WideString Read _LineFeed Write SetLineFeed; Property ValueSeperator: WideString Read _ValueSeperator Write SetValueSeperator; Property ValueQuotation: WideString Read _ValueQuotation Write SetValueQuotation; Property FileName: WideString Read _FileName Write SetFileName; Procedure LoadFromFile (Const FileName: WideString); Procedure SaveToFile (Const FileName: WideString); Procedure LoadFromStream (Stream: TStream); Procedure SaveToStream (Stream: TStream); Procedure LoadFromXML (Const XMLString: AnsiString); Overload; Procedure LoadFromXML (Const XMLString: WideString); Overload; Procedure SaveToXML (Var XMLString: AnsiString); Overload; Procedure SaveToXML (Var XMLString: WideString); Overload; Property asXML: AnsiString Read GetAsXML Write LoadFromXML; Procedure Clear; Property Version: WideString Read GetVersion Write SetVersion; Property Encoding: WideString Read GetEncoding Write SetEncoding; Property Standalone: WideString Read GetStandalone Write SetStandalone; Property Nodes: TXMLNodeList Read _Nodes Write AssignNodes; Property RootNode: TXMLNode Read GetRootNode; Property OnNodeChange: TMXLNodeChangeEvent Read _OnNodeChange Write _OnNodeChange; Property OnStatus: TXMLFileStatusEvent Read _OnStatus Write _OnStatus; Procedure _Lock; Function _TryLock: Boolean; Procedure _Unlock; Function _isLocked: Boolean; End; {***** classes : node list ********************************************************************} TXMLNodeList = Class Property Owner: TXMLFile Read _Owner; Property Parent: TXMLNode Read _Parent; Constructor Create(ParentOrOwner: TObject{TXMLNode, TXMLFile}); Destructor Destroy; Override; Property FirstNode: TXMLNode Read GetFirstNode; Property Count: Integer Read GetCount; Property Node [ Index: Integer]: TXMLNode Read GetNode; Default; Property Node [Const Name: WideString]: TXMLNode Read GetNamedNode; Default; Function Add (Const Name: WideString; NodeType: TXMLNodeType = xtElement): TXMLNode; Function Insert ( Node: TXMLNode; Index: Integer): TXMLNode; Overload; Function Insert (Const Name: WideString; Index: Integer; NodeType: TXMLNodeType = xtElement): TXMLNode; Overload; Function Remove ( Node: TXMLNode): TXMLNode; Overload; Function Remove (Const Name: WideString): TXMLNode; Overload; Function Remove ( Index: Integer): TXMLNode; Overload; Procedure Delete ( Node: TXMLNode); Overload; Procedure Delete (Const Name: WideString); Overload; Procedure Delete ( Index: Integer); Overload; Procedure Clear; Function IndexOf ( Node: TXMLNode): Integer; Overload; Function IndexOf (Const Name: WideString): Integer; Overload; Function Exists (Const Name: WideString): Boolean; Function CloneNode ( Node: TXMLNode): TXMLNode; Procedure CloneNodes( Nodes: TXMLNodeList); Property FirstNodeNF: TXMLNode Read GetNFFirstNode; Property CountNF: Integer Read GetNFCount; Property NodeNF [Const IndexOrName: TIndex]: TXMLNode Read GetNFNode; Function InsertNF ( Node: TXMLNode; Index: Integer): TXMLNode; Overload; Function InsertNF (Const Name: WideString; Index: Integer; NodeType: TXMLNodeType = xtElement): TXMLNode; Overload; Function RemoveNF ( Node: TXMLNode): TXMLNode; Overload; Function RemoveNF (Const Name: WideString): TXMLNode; Overload; Function RemoveNF ( Index: Integer): TXMLNode; Overload; Procedure DeleteNF ( Node: TXMLNode); Overload; Procedure DeleteNF (Const Name: WideString); Overload; Procedure DeleteNF ( Index: Integer); Overload; Function IndexOfNF ( Index: Integer): Integer; Overload; Function IndexOfNF ( Node: TXMLNode): Integer; Overload; Function IndexOfNF (Const Name: WideString): Integer; Overload; Function ExistsNF (Const Name: WideString): Boolean; Procedure Assign{NF}( Nodes: TXMLNodeList); Procedure Sort{NF} ( SortProc: TXMLNodeSortProc); End; {***** classes : node element *****************************************************************} TXMLNode = Class Property Owner: TXMLFile Read _Owner; Property Parent: TXMLNode Read GetParent; Property ParentList: TXMLNodeList Read _Parent; Constructor Create(ParentOrOwner: TObject{TXMLNodeList, TXMLFile}; NodeType: TXMLNodeType = xtElement); Destructor Destroy; Override; Property IndexNF: Integer Read GetNFIndex; Property Index: Integer Read GetIndex; Property Level: Integer Read GetLevel; Property NodeType: TXMLNodeType Read _Type; Property Name: WideString Read _Name Write SetName; Property Namespace: WideString Read GetNamespace Write SetNamespace; Property NameOnly: WideString Read GetNameOnly Write SetNameOnly; Property Attributes: TXMLAttributes Read _Attributes Write AssignAttributes; Property Data: WideString Read GetData Write SetData; Property Data_Base64: WideString Read GetBase64 Write SetBase64; Property XMLData: WideString Read GetXMLData Write SetXMLData; Function isTextNode: Boolean; Function hasCDATA: Boolean; Procedure asCDATA(yes: Boolean); Property Nodes: TXMLNodeList Read _Nodes Write AssignNodes; Property Attribute [Const IndexOrName: TIndex]: WideString Read GetAttribute Write SetAttribute; Property Node [Const IndexOrName: TIndex]: TXMLNode Read GetNode; Property NodeNF [Const IndexOrName: TIndex]: TXMLNode Read GetNFNode; Function AddNode (Const Name: WideString; NodeType: TXMLNodeType = xtElement): TXMLNode; Property NextNode: TXMLNode Read GetNextNode; Property NextNodeNF: TXMLNode Read GetNFNextNode; End; {***** classes : list of node attributes ******************************************************} TXMLAttributes = Class Property Owner: TXMLFile Read _Owner; Property Parent: TXMLNode Read _Parent; Constructor Create(Parent: TXMLNode); Destructor Destroy; Override; Property Count: Integer Read GetCount; Property Name [ Index: Integer]: WideString Read GetName Write SetName; Property Namespace[ Index: Integer]: WideString Read GetNamespace Write SetNamespace; Property NameOnly [ Index: Integer]: WideString Read GetNameOnly Write SetNameOnly; Property Value [ Index: Integer]: WideString Read GetValue Write SetValue; Default; Property Value [Const Name: WideString]: WideString Read GetNamedValue Write SetNamedValue; Default; Function Add (Const Name: WideString; Const Value: WideString = ''): Integer; Function Insert (Const Name: WideString; Index: Integer; Const Value: WideString = ''): Integer; Procedure Delete (Const Name: WideString); Overload; Procedure Delete ( Index: Integer); Overload; Procedure Clear; Function IndexOf (Const Name: WideString): Integer; Function Exists (Const Name: WideString): Boolean; Procedure CloneAttr( Attributes: TXMLAttributes); Procedure Assign ( Attributes: TXMLAttributes); Procedure Sort ( SortProc: TXMLAttrSortProc = nil); End; {***** constants ******************************************************************************} Const XMLUseDefault = '<default>'; // TXMLFile.FileTextIndent, TXMLFile.FileLineFeed and TXMLFile.AttrValueSep XMLUseDefaultOptions: TXMLOptions = [xo_useDefault]; // TXMLFile.Options Implementation ... diesen Post ist mir dann aufgefallen, daß ich noch keine Assign-Funktionen eingebaut hatte :oops: und wo ich gleich mal dabei war, hab ich auch dieses "Assign" auch an die Listen angekoppelt:
Delphi-Quellcode:
wär schön, wenn nochmal wer durchguckt und vielleicht noch andere Verbesserungen in der Definition findet bzw. sagt ob/was OK ist :angel:
TXMLNode = Class
Property Attributes: TXMLAttributes Read _Attributes Write AssignAttributes; Property Nodes: TXMLNodeList Read _Nodes Write AssignNodes; |
Re: himXML (gesprochen himixML)
Hi himitsu,
nette Idee. Wirst du auch die Serialisierung von Objekten und Objekt-Strukturen in deiner Klasse unterstützen? |
Re: himXML (gesprochen himixML)
Zitat:
hatte ich zwar noch nicht dran gedacht, aber möglich wär's :gruebel: du meinst doch sowas?
XML-Code:
oder
<object class="TMemo">
<value Name="Name">Memo1</value> <value Name="Left">32</value> <value Name="Top">56</value> <value Name="Width">257</value> <value Name="Height">89</value> <value Name="Lines"> <object Class="TStrings"> <value Name="Text">Memo1</value> </object> </value> <value Name="TabOrder">0</value> </object>
XML-Code:
oder gar
<object class="TMemo">
<value Name="Name">Memo1</value> <value Name="Left">32</value> <value Name="Top">56</value> <value Name="Width">257</value> <value Name="Height">89</value> <value Name="Lines.Strings">Memo1</value> <value Name="TabOrder">0</value> </object>
XML-Code:
<object class="TMemo" value1="Name:Memo1" value2="Left:32" value3="Top:56" value4="Width:257" value5="Height:89" value6="Lines.Strings::value6x" value7="TabOrder:0">
<value6x>Memo1</value6x> </object> |
Re: himXML (gesprochen himixML)
hab mal schnell ein Serialize angefangen und joar ... werd' es wohl drinlassen und später weitermachen :angel2:
Delphi-Quellcode:
- tkVariant wird noch gemacht
Procedure TXMLNode.Serialize(C: TObject; SortProps: Boolean = False);
Var i, i2, i3, i4: Integer; F: Extended; List: PPropList; Node: TXMLNode; Begin i2 := GetPropList(C.ClassInfo, List); If i2 > 0 Then Try If SortProps Then SortPropList(List, i2); For i := 0 to i2 - 1 do Case List[i].PropType^.Kind of tkUnknown: ; tkInteger: Begin Node := AddNode(List[i].Name); i3 := GetOrdProp(C, List[i].Name); If List[i].PropType^.Name = 'TColor' Then Begin i4 := 0; While i4 <= High(XMLColorStrings) do If i3 = XMLColorStrings[i3].Value Then Begin Node.Data := XMLColorStrings[i3].Name; Break; End; If i4 > High(XMLColorStrings) Then Continue; End; Node.Data := IntToStr(i3); End; tkInt64: AddNode(List[i].Name).Data := IntToStr(GetInt64Prop(C, List[i].Name)); tkEnumeration: AddNode(List[i].Name).Data := GetEnumProp(C, List[i].Name); tkSet: AddNode(List[i].Name).Data := GetSetProp(C, List[i].Name, True); tkFloat: Begin Node := AddNode(List[i].Name); F := GetFloatProp(C, List[i].Name); If List[i].PropType^.Name = 'TDateTime' Then Node.Data := DateToStr(F) Else If List[i].PropType^.Name = 'TDate' Then Node.Data := TimeToStr(F) Else If List[i].PropType^.Name = 'TTime' Then Node.Data := DateTimeToStr(F) Else Node.Data := FloatToStr(F); End; tkChar, tkWChar: Begin Node := AddNode(List[i].Name); i3 := Word(GetOrdProp(C, List[i].Name)); If (i3 > $32) and (i3 < $128) Then Node.Data := WideChar(i3) Else Node.Data := '#' + IntToStr(GetOrdProp(C, List[i].Name)); End; tkLString {$IFNDEF UNICODE}, tkString{$ENDIF}: AddNode(List[i].Name).Data := GetAnsiStrProp(C, List[i].Name); tkWString: AddNode(List[i].Name).Data := GetWideStrProp(C, List[i].Name); tkUString {$IFDEF UNICODE}, tkString{$ENDIF}: AddNode(List[i].Name).Data := GetUnicodeStrProp(C, List[i].Name); //tkClass: ; //tkMethod: ; //tkVariant: ; //tkRecord: ; //tkInterface: ; //tkArray: ; //tkDynArray: ; Else Raise EXMLException.Create('invalid PropType'); End; Finally FreeMem(List); End; End; - zu tkRecord, tkArray und tkDynArray muß ich noch sehn ob/wie - bei tkClass wird mindestens noch TStringList bearbeitet - ... - ... nja und mal sehn was sich noch machen läßt - nja und was nicht geht/gemacht wurde, könntest du dann über Callback-Prozedur nachrüsten. |
Re: himXML (gesprochen himixML)
Zitat:
Es ist mir viel lieber als Delphi 3, das ich bis vor ca. 9 Monaten auch verwendet habe. mfg Florian |
Re: himXML (gesprochen himixML)
bei diesem Code
Code:
kommt dieses raus
Type TForm1 = Class(TForm)
Label1: TLabel; Memo1: TMemo; Procedure FormCreate(Sender: TObject); Private _xyz: TMyProc; Procedure MyProc(x: Integer); Published Property xyz: TMyProc read _xyz write _xyz Stored True; End; XML := TXMLFile.Create; Node := XML.RootNode.Nodes.Add('node1'); Node.Attributes['attr1'] := '123'; Node.Attributes['attr2'] := '456'; Node.Nodes.Add('node1_2'); Node := Node.Nodes.Add('node1_3'); Node.Nodes.Add('node1_3_1'); Node := XML.RootNode.Nodes.Add('node2'); Node := Node.Nodes.Add('node2_1'); Node.Attributes['attr3'] := 'abc'; Form1.xyz := MyProc; Node := Node.Nodes.Add('object'); Node.Serialize(Form1); XML.SaveToFile('test.xml');
XML-Code:
isses OK so?
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<xml> <node1 attr1="123" attr2="456"> <node1_2 /> <node1_3> <node1_3_1 /> </node1_3> </node1> <node2> <node2_1 attr3="abc"> <object> <Tag>0</Tag> <AlignWithMargins>False</AlignWithMargins> <Left>66</Left> <Top>72</Top> <Cursor>0</Cursor> <HelpType>htContext</HelpType> <HelpContext>0</HelpContext> <Margins ClassType="TMargins"> <Left>3</Left> <Top>3</Top> <Right>3</Right> <Bottom>3</Bottom> </Margins> <ParentCustomHint>True</ParentCustomHint> <HorzScrollBar ClassType="TControlScrollBar"> <ButtonSize>0</ButtonSize> <Color>clBtnHighlight</Color> <Increment>8</Increment> <Margin>0</Margin> <ParentColor>True</ParentColor> <Position>0</Position> <Range>0</Range> <Smooth>False</Smooth> <Size>0</Size> <Style>ssRegular</Style> <ThumbSize>0</ThumbSize> <Tracking>False</Tracking> <Visible>True</Visible> </HorzScrollBar> <VertScrollBar ClassType="TControlScrollBar"> <ButtonSize>0</ButtonSize> <Color>clBtnHighlight</Color> <Increment>8</Increment> <Margin>0</Margin> <ParentColor>True</ParentColor> <Position>0</Position> <Range>0</Range> <Smooth>False</Smooth> <Size>0</Size> <Style>ssRegular</Style> <ThumbSize>0</ThumbSize> <Tracking>False</Tracking> <Visible>True</Visible> </VertScrollBar> <Align>alNone</Align> <AlphaBlend>False</AlphaBlend> <AlphaBlendValue>255</AlphaBlendValue> <AutoSize>False</AutoSize> <BorderIcons>[biSystemMenu,biMinimize,biMaximize]</BorderIcons> <BorderStyle>bsSizeable</BorderStyle> <BorderWidth>0</BorderWidth> <Caption>Form1</Caption> <ClientHeight>201</ClientHeight> <ClientWidth>329</ClientWidth> <Color>clBtnFace</Color> <TransparentColor>False</TransparentColor> <TransparentColorValue>clBlack</TransparentColorValue> <Constraints ClassType="TSizeConstraints"> <MaxHeight>0</MaxHeight> <MaxWidth>0</MaxWidth> <MinHeight>0</MinHeight> <MinWidth>0</MinWidth> </Constraints> <Ctl3D>True</Ctl3D> <UseDockManager>False</UseDockManager> <DefaultMonitor>dmActiveForm</DefaultMonitor> <DockSite>False</DockSite> <DoubleBuffered>False</DoubleBuffered> <DragKind>dkDrag</DragKind> <DragMode>dmManual</DragMode> <Enabled>True</Enabled> <ParentFont>False</ParentFont> <Font ClassType="TFont"> <Charset>1</Charset> <Color>clWindowText</Color> <Height>-11</Height> <Name>Tahoma</Name> <Orientation>0</Orientation> <Pitch>fpDefault</Pitch> <Style>[]</Style> </Font> <FormStyle>fsNormal</FormStyle> <GlassFrame ClassType="TGlassFrame"> <Enabled>False</Enabled> <Left>0</Left> <Top>0</Top> <Right>0</Right> <Bottom>0</Bottom> <SheetOfGlass>False</SheetOfGlass> </GlassFrame> <KeyPreview>False</KeyPreview> <Padding ClassType="TPadding"> <Left>0</Left> <Top>0</Top> <Right>0</Right> <Bottom>0</Bottom> </Padding>[list=1]False</OldCreateOrder> <ParentBiDiMode>True</ParentBiDiMode> <PopupMode>pmNone</PopupMode> <Position>poDefaultPosOnly</Position> <PrintScale>poProportional</PrintScale> <Scaled>True</Scaled> <ScreenSnap>False</ScreenSnap> <SnapBuffer>10</SnapBuffer> <Visible>False</Visible> <WindowState>wsNormal</WindowState> <OnCreate>TForm1:Form1:$0047BB54</OnCreate> <xyz>TForm1:Form1:$0047B894</xyz> <Components> <Component ClassType="TLabel"> <Tag>0</Tag> <AlignWithMargins>False</AlignWithMargins> <Left>32</Left> <Top>37</Top> <Width>31</Width> <Height>13</Height> <Cursor>0</Cursor> <HelpType>htContext</HelpType> <HelpContext>0</HelpContext> <Margins ClassType="TMargins"> <Left>3</Left> <Top>3</Top> <Right>3</Right> <Bottom>3</Bottom> </Margins> <ParentCustomHint>True</ParentCustomHint> <Align>alNone</Align> <Alignment>taLeftJustify</Alignment> <AutoSize>True</AutoSize> <Caption>Label1</Caption> <Constraints ClassType="TSizeConstraints"> <MaxHeight>0</MaxHeight> <MaxWidth>0</MaxWidth> <MinHeight>0</MinHeight> <MinWidth>0</MinWidth> </Constraints> <DragCursor>-12</DragCursor> <DragKind>dkDrag</DragKind> <DragMode>dmManual</DragMode> <EllipsisPosition>epNone</EllipsisPosition> <Enabled>True</Enabled> <GlowSize>0</GlowSize> <ParentBiDiMode>True</ParentBiDiMode> <ParentColor>True</ParentColor> <ParentFont>True</ParentFont> <ParentShowHint>True</ParentShowHint> <ShowAccelChar>True</ShowAccelChar> <Layout>tlTop</Layout> <Visible>True</Visible> <WordWrap>False</WordWrap> </Component> <Component ClassType="TMemo"> <Tag>0</Tag> <AlignWithMargins>False</AlignWithMargins> <Left>32</Left> <Top>56</Top> <Width>257</Width> <Height>89</Height> <Cursor>0</Cursor> <HelpType>htContext</HelpType> <HelpContext>0</HelpContext> <Margins ClassType="TMargins"> <Left>3</Left> <Top>3</Top> <Right>3</Right> <Bottom>3</Bottom> </Margins> <ParentCustomHint>True</ParentCustomHint> <TabStop>True</TabStop> <Align>alNone</Align> <Alignment>taLeftJustify</Alignment> <BevelEdges>[beLeft,beTop,beRight,beBottom]</BevelEdges> <BevelInner>bvRaised</BevelInner> <BevelKind>bkNone</BevelKind> <BevelOuter>bvLowered</BevelOuter> <BorderStyle>bsSingle</BorderStyle> <CharCase>ecNormal</CharCase> <Color>clWindow</Color> <Constraints ClassType="TSizeConstraints"> <MaxHeight>0</MaxHeight> <MaxWidth>0</MaxWidth> <MinHeight>0</MinHeight> <MinWidth>0</MinWidth> </Constraints> <DragCursor>-12</DragCursor> <DragKind>dkDrag</DragKind> <DragMode>dmManual</DragMode> <Enabled>True</Enabled> <HideSelection>True</HideSelection> <ImeMode>imDontCare</ImeMode> <Lines ClassType="TMemoStrings"> <Strings> <String>Memo1</String> <String /> <String>abc</String> </Strings> </Lines> <MaxLength>0</MaxLength> <OEMConvert>False</OEMConvert> <ParentBiDiMode>True</ParentBiDiMode> <ParentColor>False</ParentColor> <ParentCtl3D>True</ParentCtl3D> <ParentDoubleBuffered>True</ParentDoubleBuffered> <ParentFont>True</ParentFont> <ParentShowHint>True</ParentShowHint> <ReadOnly>False</ReadOnly> <ScrollBars>ssNone</ScrollBars> <TabOrder>0</TabOrder> <Visible>True</Visible> <WantReturns>True</WantReturns> <WantTabs>False</WantTabs> <WordWrap>True</WordWrap> </Component> </Components> </object> </node2_1> </node2> </xml> (hier sind jetzt nur Stored-Property <> Default-Wert drin) bei Propertys, welche nicht von meiner Serialize-Prozedur verarbeitet werden, wird erstmal soeine Prozedur aufzurufen (wenn angegeben) und wenn Beides das Property nicht verarbeitet, dann gibt's eine Exception.
Delphi-Quellcode:
man kann diese Prozedut auch nutzen, um selbst anzugeben, welche Properties gespeichert bzw. geladen (bei Deserialize) werden sollen.
Function SerializeProc(C: TObject; Const PropertyName: AnsiString; NodeList: TXMLNodeList): Boolean;
Var Node: TXMLNode; Begin Node := NodeList.Add(PropertyName); Node.Attributes['unknown'] := 'True'; //Node.Attributes['Name'] := GetPropInfo(C, PropertyName).PropType^.Name; //Node.Attributes['Type'] := cTypeKind[GetPropInfo(C, PropertyName).PropType^.Kind]; Result := True; // True wenn verarbeitet ... egal ob ein Node erstellt, oder ignoriert wurde // bei False wird (womöglich) eine Exception geworfen, daß ein Property nicht bearbeitet wurde End; Node.Serialize(Form1, [], SerializeProc); Ist NodeList = nil, dann wird über Result bestimmt, was geschehen soll. True = Property versuchen zu speichern (falls unbekannt, dann wird diese Funktion nochmals aufgerufen ... siehe vorheriges Beispiel) False = Property nicht speichern/laden
Delphi-Quellcode:
Function SerializeProc(C: TObject; Const PropertyName: AnsiString; NodeList: TXMLNodeList): Boolean;
Var Node: TXMLNode; Begin If Assigned(NodeList) Then Begin Node := NodeList.Add(PropertyName); Node.Attributes['unknown'] := 'True'; //Node.Attributes['Name'] := GetPropInfo(C, PropertyName).PropType^.Name; //Node.Attributes['Type'] := cTypeKind[GetPropInfo(C, PropertyName).PropType^.Kind]; Result := True; End Else Begin // only if xsQueryBefore is set Result := PropertyName <> 'Name'; End; End; Node.Serialize(Form1, [xsNonStoredProperties, xsQueryBefore], SerializeProc); das Ganze läßt sich dann natürlich auch noch auf bestimmte Property eingrenzen:
Delphi-Quellcode:
als Parameter gibt's dieses:
Function SerializeProc(C: TObject; Const PropertyName: AnsiString; NodeList: TXMLNodeList): Boolean;
Var Node: TXMLNode; Begin If (C is TMyClass) and (PropertyName = 'MyProperty') Then Begin Node := NodeList.Add(PropertyName); Node.Data := LeseDaten(C, PropertyName); Result := True; End Else Result := False; End; // hier wird nur das Property "MyProperty" des übergebenen Objektes gespeichert Function SerializeProc(C: TObject; Const PropertyName: AnsiString; NodeList: TXMLNodeList): Boolean; Var Node: TXMLNode; Begin If Assigned(NodeList) Then Begin If (C is TMyClass) and (PropertyName = 'MyProperty') Then Begin Node := NodeList.Add(PropertyName); Node.Data := LeseDaten(C, PropertyName); Result := True; End Else Result := False; End Else Begin // only if xsQueryBefore is set Result := (C is TMyClass) and (PropertyName = 'MyProperty'); End; End; // hier wird alles gespeichert, was meine Funktion speichern kann // und zusätzlich noch das Property "MyProperty" (welches meine Funktion nicht kennt) Function SerializeProc(C: TObject; Const PropertyName: AnsiString; NodeList: TXMLNodeList): Boolean; Var Node: TXMLNode; Begin If Assigned(NodeList) Then Begin If (C is TMyClass) and (PropertyName = 'MyProperty') Then Begin Node := NodeList.Add(PropertyName); Node.Data := LeseDaten(C, PropertyName); Result := True; End Else Result := True; End Else Begin // only if xsQueryBefore is set Result := True; End; End;
Code:
ich räum jetzt noch den Code etwas auf
xsSortProperties sortiert die Properties
xsDefaultProperties speichert auch Properties, welche ihrem "Default"-Wert entsprechen xsNonStoredProperties speichert auch Properties, welche nicht mit "Stored" markiert sind xsSaveClassType speichert den Klassen-Typ siehe <Lines ClassType="TMemoStrings"> wäre es mit angegeben gewesen, dann stünde statt <object> jetzt <object ClassType="TForm1"> xsSavePropertyInfos ist mehr für Debugzwecke entspricht Name=".PropType^.Name" Type=".PropType^.Kind"; xsQueryBefore ruft SerializeProc auf und fragt, ob das Property gespeichert werden soll ... siehe Beispiele und lad dann eventuell den aktuellen Code mal hoch ansonsten bastel jetzt erstmal wieder am Parsen rum (das Lesen geht immernoch nicht so, wie ich es gern hätte) [add] im vollen Modus kommt sowas raus
Delphi-Quellcode:
es wird alles gespeichert ... nur "Name" nicht ... und das nicht behandelbare TIcon wurde von SerializeProc erstellt
Function SerializeProc(C: TObject; Const PropertyName: AnsiString; NodeList: TXMLNodeList): Boolean;
Const cTypeKind: Array[TTypeKind] of String = ('Unknown', 'Integer', 'Char', 'Enumeration', 'Float', 'String', 'Set', 'Class', 'Method', 'WChar', 'LString', 'WString', 'Variant', 'Array', 'Record', 'Interface', 'Int64', 'DynArray', 'UString'); Var Node: TXMLNode; Begin If Assigned(NodeList) Then Begin Node := NodeList.Add(PropertyName); Node.Attributes['unknown'] := 'True'; Node.Attributes['unknown_Name'] := GetPropInfo(C, PropertyName).PropType^.Name; Node.Attributes['unknown_Type'] := cTypeKind[GetPropInfo(C, PropertyName).PropType^.Kind]; Result := True; End Else Begin // only if xsQueryBefore is set Result := PropertyName <> 'Name'; End; End; Node.Serialize(Form1, [xsDefaultProperties, xsNonStoredProperties, xsSaveClassType, xsSavePropertyInfos, xsQueryBefore], SerializeProc);
XML-Code:
Das Deserialize fehlt auch noch ... mach erstmal Serialize fertig und wende mich dann dem deserialisieren zu (hab da noch ein paar Problemchen beim Speichern auszumerzen)
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<xml> ... <node2> <node2_1 attr3="abc"> <object ClassType="TForm1"> <Tag Name="Integer" Type="Integer">0</Tag> <AlignWithMargins Name="Boolean" Type="Enumeration">False</AlignWithMargins> <Left Name="Integer" Type="Integer">88</Left> <Top Name="Integer" Type="Integer">96</Top> <Width Name="Integer" Type="Integer">337</Width> <Height Name="Integer" Type="Integer">230</Height> <Cursor Name="TCursor" Type="Integer">0</Cursor> <Hint Name="string" Type="UString" /> <HelpType Name="THelpType" Type="Enumeration">htContext</HelpType> <HelpKeyword Name="string" Type="UString" /> <HelpContext Name="THelpContext" Type="Integer">0</HelpContext> <Margins Name="TMargins" Type="Class" ClassType="TMargins"> <Left Name="TMarginSize" Type="Integer">3</Left> <Top Name="TMarginSize" Type="Integer">3</Top> <Right Name="TMarginSize" Type="Integer">3</Right> ... <Icon unknown="True" unknown_Name="TIcon" unknown_Type="Class" /> |
Re: himXML (gesprochen himixML)
so, hab oben mal eine Neuere Verion angehängt
einige kleine Änderungen gab's und vorallem kann man jetzt Nodes einfacher aufrufen/erstellen/prüfen/löschen
Delphi-Quellcode:
geht jetzt auch
XML.RootNode.Nodes.Node['node1'].Nodes.Node['node2'].Nodes.Add('node3')
XML.RootNode.Nodes['node1'].Nodes['node2'].AddNode('node3')
Delphi-Quellcode:
um in <xml><node1><node2> den <node3> zu erstellen
XML.RootNode.AddNode('node1\node2\node3')
(nur in IndexOf/IndexOfNF funktioniert dieses "absichtlich" nicht) ich werd das demnächst auch bei den Namesangaben der Attribute umsetzen
Delphi-Quellcode:
für <xml><node1><node2 attr="">
XML.RootNode.Nodes.Node['node1'].Nodes.Node['node2'].Attributes['attr']
XML.RootNode.Nodes['node1'].Nodes['node2'].Attributes['attr'] XML.RootNode.Attributes['node1\node2\attr'] außerdem soll man dann statt bzw. zusammen mit dem Node-Namen auch einen Parameter mit angeben können z.B. für den 2. Node:
Delphi-Quellcode:
<node1 attr="name1">
Nodes['node2']
Nodes['>attr=name2'] Nodes['node2>attr=name2'] <node2 attr="name2"> <node3 attr="name3"> |
Re: himXML (gesprochen himixML)
Hallo himitsu,
deine Klasse lässt sich mit Delphi 7 PE nicht nutzen, da einige Klassen sowie Sprachkonstrukte nicht zur Verfügung stehen. Zum Beispiel folgendes funktioniert nicht:
Delphi-Quellcode:
Class Operator Implicit
Zitat:
|
Re: himXML (gesprochen himixML)
Klassenoperatoren werden unter Win32 auch erst ab D10 (BDS2006/TD(E)) unterstützt
|
Re: himXML (gesprochen himixML)
Jupp, die erste Version war (Aufgrund eines Fehlers, den aber keiner erwähnte) nur in Delphi2009 wirklich lauffähig und die aktuelle Version läuft getestet ab Delphi2006 / Turbo Delphi.
Wenn das Projekt soweit fertig ist und läuft, wird es vermutlich eine abgespeckte und in einigen Properties leicht geänderte(umbenannte) Version geben, welche auch in früheren Versionen lauffähig sein wird. (bis D7 runter kann ich dabei dann selber testen) Zitat:
|
Re: himXML (gesprochen himixML)
Wie handhabst du bei Node1/Node2/Node3 eigentlich die Auswahl von gleichnamigen Knoten auf einer Ebene? Also wenn ich mit der zuvor genannten Angabe aber auf der 2. Ebene den 6. Knoten mit dem Namen Node2 haben will?
|
Re: himXML (gesprochen himixML)
Bei gleichnamigen Nodes wird der zuerst Gefundene zurückgegeben.
Hmmmm, also daran hatte ich noch garnicht gedacht, aber wenn ich mir das so überleg ... [ und ] sind in Nodenames eh nicht erlaubt, dann könnte ich da ja noch einen Index anzubieten? :gruebel: Zitat:
Und bezüglich des Problems bei mehrere gleichnamiger Nodes hab auch schon 'ne Weile geplant mal eine Funktion zu erstellen, welche dann ein Array mit all den gefundenen Nodes zurück gibt. Also daß statt sowas Nodes['Nodename'] dann weißnochnichtwieichdasnenn['Nodename'] nicht den ersten Node liefert, sondern eben ein Array of Node. |
Re: himXML (gesprochen himixML)
... bzw. eine NodeList. Genauso habe ich es in meiner auch gelöst gehabt - also eine NodeList und die [] in den Pfadangaben für die Indizierung gleichnamiger.
|
Re: himXML (gesprochen himixML)
Eine ganze NodeList wollte ich dafür nicht gleich verwenden, denn ansonstenmüßte ich darin entweder das Erstellen/Ändern von Nodes unterbinden oder irgendwie synchronisieren und ein einfaches Array hätte eigentlich doch auch gereicht. :roll:
Das Ganze wollte ich ja auch noch "möglichst" Schlank halten :angel und Aufgrund der Speicherverwaltung nur mit Objekten ist es garnicht so leicht möglich extra eine NodeList dafür zu verwenden, denn wie soll diese wieder freigegeben werden? Ansonsten zeigen manche Problemchen auch, daß Einiges mit Interfaces wohl leichter zu lösen wäre. |
Re: himXML (gesprochen himixML)
Zitat:
Und wenn einer einen Knoten aus der Liste löscht oder freigibt, dann kann sich dieser Knoten doch selbst in seinem Überknoten entfernen. Gleiches hatte ich in meiner Lib auch gemacht - funktioniert einwandfrei. Dadurch war das Knoten löschen recht einfach: einfach freigeben mit .Free und der Knoten samt seinen Unterknoten wird ordentlich freigegeben und die Struktur bei dir im Speicher ist aktuell. Was will man mehr? Das ist doch gerade das schöne an OOP und den Instanzen. Zitat:
Zitat:
Objekte sollten immer auf der gleichen Ebene freigegeben werden wo sie auch alloziiert werden. Also kannst du schonmal keine Rückgabeliste erzeugen, also bekommst du eine vom Nutzer übergeben. Der legt sie an und gibt sie auf der gleichen Ebene wieder frei. Schau dir doch einfach meine Lib an in Sachen Objektverwaltung - zur Not kopier es dir sogar. Die Lib ist (öffentlich) tot und du kannst dich frei bedienen. |
Re: himXML (gesprochen himixML)
@Muetze1: mal sehn wie ich das dann umsetze.
jetzt hab ich erstmal die Variants soweit fertigbekommen Floats werd ich noch selber umwandeln müssen ... Delphi lokalisiert ja leider das Komma, wie ich grade mitbekommen hab :? (blöd bei Weitergabe der XML-Datei) die Exceptionen hab ich nun fast alle mal ordentlich umgesetzt und wie man am Beispielcode sieht, hab ich den Index ( Node['name[i]'] ) schon drin :mrgreen: dieses ...
Delphi-Quellcode:
... erstellt jetzt jenes :-D
Type TMyProc = Procedure(X: Integer) of Object;
Type TForm1 = Class(TForm) Label1: TLabel; Memo1: TMemo; Procedure FormCreate(Sender: TObject); Private Public _xyz: TMyProc; _abc: TXMLNodeTypes; _va: Variant; Published Procedure MyProc(x: Integer); Property xyz: TMyProc read _xyz write _xyz Stored True; Property abc: TXMLNodeTypes read _abc write _abc Stored True Default [xtElement]; Property va: Variant read _va write _va; End; Var XML: TXMLFile; Node: TXMLNode; z: Array of Array of Array of Single; XML := TXMLFile.Create; Try Node := XML.RootNode.AddNode('node1'); Node.Attributes['attr1'] := '123'; Node.Attributes['attr2'] := '456'; Node.AddNode('node1_2'); Node := Node.AddNode('node1_3'); Node.AddNode('node1_3_1'); Node := XML.RootNode.AddNode('node2'); Node := Node.AddNode('node2_1'); Node.Attributes['attr3'] := 'abc'; XML.Options := XML.Options + [xoNodeAutoCreate]; XML.RootNode.AddNode('.\node1\..\node2\path\node3'); XML.RootNode.AddNode('.\node1\..\node2\path>test=x\node4'); XML.RootNode.AddNode('.\node1\..\node2\path\node5'); XML.RootNode.AddNode('.\node1\..\node2\path>test=x\node6'); Form1.abc := [xtElement]; Form1.xyz := Form1.MyProc; SetLength(z, 2); SetLength(z[0], 3); SetLength(z[1], 3); SetLength(z[0, 0], 2); SetLength(z[0, 1], 2); SetLength(z[0, 2], 2); SetLength(z[1, 0], 2); SetLength(z[1, 1], 2); SetLength(z[1, 2], 2); z[0, 0, 0] := 000; z[0, 0, 1] := 001; z[0, 1, 0] := 010; z[0, 1, 1] := 011.110; z[0, 2, 0] := 020; z[0, 2, 1] := 021; z[1, 0, 0] := 100; z[1, 0, 1] := 101; z[1, 1, 0] := 110; z[1, 1, 1] := 111; z[1, 2, 0] := 120; z[1, 2, 1] := 121.121; Form1.va := z; Node := XML.RootNode.AddNode('object'); Node.Serialize(Form1, [], SerializeProc); XML.SaveToFile('test.xml'); Finally XML.Free; End;
XML-Code:
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<xml> <node1 attr1="123" attr2="456"> <node1_2 /> <node1_3> <node1_3_1 /> </node1_3> </node1> <node2> <node2_1 attr3="abc" /> <path> <node3 /> <node5 /> </path> <path test="x"> <node4 /> <node6 /> </path> </node2> <object> <Tag>0</Tag> <AlignWithMargins>False</AlignWithMargins> <Left>132</Left> <Top>144</Top> <Cursor>0</Cursor> <HelpType>htContext</HelpType> <HelpContext>0</HelpContext> <Margins ClassType="TMargins"> <Left>3</Left> <Top>3</Top> <Right>3</Right> <Bottom>3</Bottom> </Margins> <ParentCustomHint>True</ParentCustomHint> <HorzScrollBar ClassType="TControlScrollBar"> <ButtonSize>0</ButtonSize> <Color>clBtnHighlight</Color> <Increment>8</Increment> <Margin>0</Margin> <ParentColor>True</ParentColor> <Position>0</Position> <Range>0</Range> <Smooth>False</Smooth> <Size>0</Size> <Style>ssRegular</Style> <ThumbSize>0</ThumbSize> <Tracking>False</Tracking> <Visible>True</Visible> </HorzScrollBar> <VertScrollBar ClassType="TControlScrollBar"> <ButtonSize>0</ButtonSize> <Color>clBtnHighlight</Color> <Increment>8</Increment> <Margin>0</Margin> <ParentColor>True</ParentColor> <Position>0</Position> <Range>0</Range> <Smooth>False</Smooth> <Size>0</Size> <Style>ssRegular</Style> <ThumbSize>0</ThumbSize> <Tracking>False</Tracking> <Visible>True</Visible> </VertScrollBar> <Align>alNone</Align> <AlphaBlend>False</AlphaBlend> <AlphaBlendValue>255</AlphaBlendValue> <AutoSize>False</AutoSize> <BorderIcons>[biSystemMenu,biMinimize,biMaximize]</BorderIcons> <BorderStyle>bsSizeable</BorderStyle> <BorderWidth>0</BorderWidth> <Caption>Form1</Caption> <ClientHeight>201</ClientHeight> <ClientWidth>329</ClientWidth> <Color>clBtnFace</Color> <TransparentColor>False</TransparentColor> <TransparentColorValue>clBlack</TransparentColorValue> <Constraints ClassType="TSizeConstraints"> <MaxHeight>0</MaxHeight> <MaxWidth>0</MaxWidth> <MinHeight>0</MinHeight> <MinWidth>0</MinWidth> </Constraints> <Ctl3D>True</Ctl3D> <UseDockManager>False</UseDockManager> <DefaultMonitor>dmActiveForm</DefaultMonitor> <DockSite>False</DockSite> <DoubleBuffered>False</DoubleBuffered> <DragKind>dkDrag</DragKind> <DragMode>dmManual</DragMode> <Enabled>True</Enabled> <ParentFont>False</ParentFont> <Font ClassType="TFont"> <Charset>1</Charset> <Color>clWindowText</Color> <Height>-11</Height> <Name>Tahoma</Name> <Orientation>0</Orientation> <Pitch>fpDefault</Pitch> <Style>[]</Style> </Font> <FormStyle>fsNormal</FormStyle> <GlassFrame ClassType="TGlassFrame"> <Enabled>False</Enabled> <Left>0</Left> <Top>0</Top> <Right>0</Right> <Bottom>0</Bottom> <SheetOfGlass>False</SheetOfGlass> </GlassFrame> <KeyPreview>False</KeyPreview> <Padding ClassType="TPadding"> <Left>0</Left> <Top>0</Top> <Right>0</Right> <Bottom>0</Bottom> </Padding>[list=1]False</OldCreateOrder> <ParentBiDiMode>True</ParentBiDiMode> <PopupMode>pmNone</PopupMode> <Position>poDefaultPosOnly</Position> <PrintScale>poProportional</PrintScale> <Scaled>True</Scaled> <ScreenSnap>False</ScreenSnap> <SnapBuffer>10</SnapBuffer> <Visible>False</Visible> <WindowState>wsNormal</WindowState> <OnCreate>TForm1:Form1:FormCreate</OnCreate> <xyz>TForm1:Form1:MyProc</xyz> <abc>[xtElement]</abc> <va variant="Single-Array" dimensions="3"> <dimDef0 count="2" low="0" /> <dimDef1 count="3" low="0" /> <dimDef2 count="2" low="0" /> <dim0> <dim0> <dim0>0</dim0> <dim1>1</dim1> </dim0> <dim1> <dim0>10</dim0> <dim1>11,1099996566772</dim1> </dim1> <dim2> <dim0>20</dim0> <dim1>21</dim1> </dim2> </dim0> <dim1> <dim0> <dim0>100</dim0> <dim1>101</dim1> </dim0> <dim1> <dim0>110</dim0> <dim1>111</dim1> </dim1> <dim2> <dim0>120</dim0> <dim1>121,121002197266</dim1> </dim2> </dim1> </va> <Components> <Component ClassType="TLabel"> <Tag>0</Tag> <AlignWithMargins>False</AlignWithMargins> <Left>32</Left> <Top>37</Top> <Width>31</Width> <Height>13</Height> <Cursor>0</Cursor> <HelpType>htContext</HelpType> <HelpContext>0</HelpContext> <Margins ClassType="TMargins"> <Left>3</Left> <Top>3</Top> <Right>3</Right> <Bottom>3</Bottom> </Margins> <ParentCustomHint>True</ParentCustomHint> <Align>alNone</Align> <Alignment>taLeftJustify</Alignment> <AutoSize>True</AutoSize> <Caption>Label1</Caption> <Constraints ClassType="TSizeConstraints"> <MaxHeight>0</MaxHeight> <MaxWidth>0</MaxWidth> <MinHeight>0</MinHeight> <MinWidth>0</MinWidth> </Constraints> <DragCursor>-12</DragCursor> <DragKind>dkDrag</DragKind> <DragMode>dmManual</DragMode> <EllipsisPosition>epNone</EllipsisPosition> <Enabled>True</Enabled> <GlowSize>0</GlowSize> <ParentBiDiMode>True</ParentBiDiMode> <ParentColor>True</ParentColor> <ParentFont>True</ParentFont> <ParentShowHint>True</ParentShowHint> <ShowAccelChar>True</ShowAccelChar> <Layout>tlTop</Layout> <Visible>True</Visible> <WordWrap>False</WordWrap> </Component> <Component ClassType="TMemo"> <Tag>0</Tag> <AlignWithMargins>False</AlignWithMargins> <Left>32</Left> <Top>56</Top> <Width>257</Width> <Height>89</Height> <Cursor>0</Cursor> <HelpType>htContext</HelpType> <HelpContext>0</HelpContext> <Margins ClassType="TMargins"> <Left>3</Left> <Top>3</Top> <Right>3</Right> <Bottom>3</Bottom> </Margins> <ParentCustomHint>True</ParentCustomHint> <TabStop>True</TabStop> <Align>alNone</Align> <Alignment>taLeftJustify</Alignment> <BevelEdges>[beLeft,beTop,beRight,beBottom]</BevelEdges> <BevelInner>bvRaised</BevelInner> <BevelKind>bkNone</BevelKind> <BevelOuter>bvLowered</BevelOuter> <BorderStyle>bsSingle</BorderStyle> <CharCase>ecNormal</CharCase> <Color>clWindow</Color> <Constraints ClassType="TSizeConstraints"> <MaxHeight>0</MaxHeight> <MaxWidth>0</MaxWidth> <MinHeight>0</MinHeight> <MinWidth>0</MinWidth> </Constraints> <DragCursor>-12</DragCursor> <DragKind>dkDrag</DragKind> <DragMode>dmManual</DragMode> <Enabled>True</Enabled> <HideSelection>True</HideSelection> <ImeMode>imDontCare</ImeMode> <Lines ClassType="TMemoStrings"> <Strings> <String>Memo1</String> <String /> <String>abc</String> </Strings> </Lines> <MaxLength>0</MaxLength> <OEMConvert>False</OEMConvert> <ParentBiDiMode>True</ParentBiDiMode> <ParentColor>False</ParentColor> <ParentCtl3D>True</ParentCtl3D> <ParentDoubleBuffered>True</ParentDoubleBuffered> <ParentFont>True</ParentFont> <ParentShowHint>True</ParentShowHint> <ReadOnly>False</ReadOnly> <ScrollBars>ssNone</ScrollBars> <TabOrder>0</TabOrder> <Visible>True</Visible> <WantReturns>True</WantReturns> <WantTabs>False</WantTabs> <WordWrap>True</WordWrap> </Component> </Components> </object> </xml> |
Re: himXML (gesprochen himixML)
|
Re: himXML (gesprochen himixML)
so, nun ist auch das En-/Decoding nehezu komplett überarbeitet worden
( unvollständige MultiByte-Zeichen erkennen)und auch die Speicherprozedur würde etwas gendärt ... nur blöd, daß die Dekodierung garnicht sooooo langsam war ... aktuell nur etwa 60-70 ms für's Dekodieren und Speichern ... das Meißte an Plus wurde durch 'ne winzig kleine Änderung rausgeholt .... ich hatte ausversehn nach jedem Node ein Flush (Schreibpuffer leeren) drin ... also so etwa 35 Dekodier-/Speicheroperationen wurde dieses über 100.000 Mal in sehr kleinen Stücken gemacht :wall: ja und Node.Next war sehr disoptimal (2-3 Sekunden für .Next und nochmal knapp 7-8 für's Flush) hier nochmal die Testergebnisse für 100.000 Nodes (ergibt ca. eine 1,5 MB-Datei)
Code:
aktueller Code kommt mit dem nächten Update und eventuell schon zusammen mit der Leseroutine (LoadFromFile und Co.)
[b]alt[/b]
TXMLDocument = fill:672687 save: 391 free: 140 TXMLFile = fill: 125 save:10922 free:3110 [b]TXMLDocument/IXMLDocument[/b] Taskmanager: 11,5 Minuten mit bis zu 138 MB Speicherverbrauch fill:692875 save:360 free:125 [b]himXML[/b] Taskmanager: 3 Sekunden mir nur 22 MB fill:110 save:125 free:2812 (Zeiten in Millisekunden) [add] so, noch 'ne kleine Änderung in NodeList.Clear (einfach alles löschen und zusammen entfernen, statt einzeln entfernen und löschen)
Delphi-Quellcode:
Ergebnis:
// alt
Procedure TXMLNodeList.Clear; Begin While _Nodes <> nil do DeleteNF(_Nodes[0]); End; // neu Procedure TXMLNodeList.Clear; Var i: Integer; Begin If _Nodes <> nil Then Try For i := High(_Nodes) downto 0 do FreeAndNil(_Nodes[i]); _Nodes := nil; Except i := Length(_Nodes); While (i > 0) and (_Nodes[i - 1] = nil) do Dec(i); SetLength(_Nodes, i); Raise; End; End;
Code:
also 0,26 Sekunden, statt über 11 Minuten bei MSXML (TXMLDocument), um 100.000 Nodes einzufügen und diese 1,5 MB-Datei zu speichern :angel:
create:0 fill:109 save:125 free:31
|
Re: himXML (gesprochen himixML)
* einige Speicherroutinen überarbeitet (vorallem die Stringverarbeitung)
* es wurden endlich mal alle Datentests und -konverter fertiggestllt, also die Prüfung auf gültige Daten, welche man an Nodes und Attributes übergibt * die Variants sind auch wieder drin (waren mal kurz weg, da sich 'nen altes Backup einschlich :wall: ) * Code etwas aufgeräumt * und ich scheine auch endlich mal "alle" fehlenden/leeren Prozeduren gefüllt zu haben :-D * aktueller Stand siehe Post #1 fehlt NUR noch: * Deserialasierung für Objekte * die Parserfunktion für LoadFromFile und Co. und sonst scheint alles fertig zusein, falls sich keine Fehler eingeschlichen haben (werd' aber die nächsten Tage alles nochmal ansehn und etwas testen) |
Re: himXML (gesprochen himixML)
beim Aufräumen hab ich jetzt mal den SpeedTest ausgelagert
(er wird später noch durch 'nen Ladevergleich erweitert)
Code:
Zeiten in Millisekunden
SetProcessAffinityMask: OK
fill TXMLFile with 10.000 nodes and save this into a file QPC > create:0 fill:9 save:15 free:3 fill TXMLDocument with 10.000 nodes and save this into a file QPC > create:13 fill:6805 save:92 free:0 fill TXMLFile with 10.000 nodes, delete 8.000 nodes and save this into a file QPC > create:0 fill:10 delete:1545 save:5 free:0 fill TXMLDocument with 10.000 nodes, delete 8.000 nodes and save this into a file QPC > create:0 fill:6799 delete:103127 save:46 free:0 fill TXMLFile with 10.000 nodes with attributes and save this into a file QPC > create:0 fill:683 save:22 free:4 fill TXMLDocument with 10.000 nodes with attributes and save this into a file QPC > create:0 fill:6536 save:126 free:0 fill TXMLFile with 100.000 nodes and save this into a file QPC > create:0 fill:104 save:128 free:31 fill TXMLDocument with 100.000 nodes and save this into a file QPC > create:0 fill:743807 save:194 free:0 press [enter] er läuft jetzt als Konsolenanwendung und die Ausführung läßt sich somit jederzeit beenden, ohne 'ne werteverfälschende Prüfung in den Schleifen. (z.B. hab ich mitbekommen, daß ein Aufruf von ~200.000 mal QueryPerformenceCounter + Int64-Addition/-Subtraktion auch gut mal 'ne Sekunde fressen kann) [add] falls zufällig wer Wrapper für TIniFile bzw. TRegistry nach XML braucht ... siehe Anhang (damit könnte man alte Anwendungen recht schnell auf XML umstellen oder mit der "bekannten" Benutzung dieser Komponenten dennoch eine XML-Datei verwenden) [edit 21.05.] Anhänge entfernt ... sind im Anhang des Post #1 inzwischen enthalten - himXML_Tools.pas - Wrapper für TIniFile und TRegistry - SpeedTest.dpr |
Re: himXML (gesprochen himixML)
Schon schlimm, eigentlich wollte ich mein
MatchText nur etwas hierfür anpassen und nun artet auch noch das mehr aus, als gedacht :freak: Eigentlich wollt ich nur, vorallem wegen der Namespaces eine/zwei neue und auch andersweitig verwendbare Syntax zur Namensdefinition von Nodes einbinden, also "*:node" und "namespace:*" um den Namespace zu ignorieren, bzw. um alles nur von einem NameSpace aufzulisten,wobei "*" und "?" denmächts auch für alle möglichen Maskendefinitionen zur Verfügung stehen. (hierfür wurde gestern auch noch die Möglichkeit eingebaut, nun auch bei den Attributen eine Auswahlliste über solche "Masken" zu bekommen und nicht immer nur "einzelne" Attribute) Und wollte (schonwieder dieses Wort :shock: ) damit gleich noch ein anderes Problem beseitigen:Aktuell arbeitet meine Lib caseinsensitiv (damit es gewisse Probleme nicht gibt).Wenn ich es dann abgeändert hab, wird die Lib per Standard zwar immernoch caseinsensitiv sein... kann aber umgestellt werden, damit sie auch dort dann nach der XML-Spezifikation arbeitet. :angel2: |
Re: himXML (gesprochen himixML)
Also, das mit'm Einlesen geht langsam vorran (war in letzter Zeit vorwiegend damit beschäftigt alle Lese-/Schreibgrundroutinen diesbezüglich umzustellen :freak: )
Ansonsten hab ich mal was getestet, welches die ganze Zeit vernachlässigt wurde ... und zwar das Suchen von Nodes. z.B. alle 10.000 Nodes in zufälliger Reinfolge aus einer Reihe von 10.000 Subnodes rauszusuchen und das ersten und einzige Attribut auszulesen dauerte ~6,7 Sekunden (bei mir) War mir etwas viel, drum hab ich da heut noch Einiges geändert :stupid: und einen Hashvergleich vor gewisse Stringvergleiche vorgeschaltet. OK, so sehr viel Zeit konnte ich damit dann doch nicht rausholen, wie zuerst erhoft (mal sehn wo es noch hängt), aber fast doppelt so schnell ist auch schön :angel2: Dieses meinte dann das Testprogramm (siehe SpeedTest.dpr Post #1) dazu:
Code:
Obwohl, wenn ich mir das jetzt so betrachte ... gegenüber dem MS-XMLDOM ist/war es ja doch noch recht flott unterwegs. :mrgreen:
SetProcessAffinityMask: OK
use QueryPerformanceCounter precreating used strings - do not create and convert this within the measuring create:72 fill TXMLFile with 10.000 nodes with attributes and search nodes create:0 fill:602 search:3268 free:8 fill TXMLDocument with 10.000 nodes with attributes and search nodes create:3 fill:6394 search:146699 free:0 press [enter] Sind durchschnittlich 0,33 Millisekunden zum raussuchen eines Knotens aus 10.000 eigentlich schnell/langsam? (hab jetzt noch keine Vergleichsmessungen an anderen Listen vorgenommen oder solche Zeiten irgendwo gelesen) Und ich geb's zu ... zu dieser Optimierung hatten mich alzaimar's Hash-Tabellen verleitet, welche ich noch etwas im Kopf rumschwirren hatte.Zitat:
(durchschnittlich bei über 20 Byte war CRC32 ein bissl flotter und darunter ELF) nja, so brauchte ich zumindestens nicht noch 'ne Hashtabelle mit unterbringen :stupid: und der ELF ließ sich durch kleine Umbauten (incl. ein/zwei Extras für meine Bedürfnisse) direkt auf's Unicode (2 Byte pro Durchgang der Berechnungsschleife) loslassen und das fast nochmal doppelt so schnell (in diesem Sinne war es dann doch wesentlich schneller :thumb: ) Angang siehe Post #1[edit] Anhang (Post #1) durch 'ne Ansi-Version ersetzt ... wo kam denn das UTF8 schonwieder her? :shock: |
Re: himXML (gesprochen himixML)
Hab jetzt noch eine Serialisierung von Records und (dyn.) Arrays implementiert
(aktuell noch nur die Serialisierung ... die Deserialisierung kommt, sobald ich diesen Code halbwegs getestet und "ganz" fertig hab). Allerdings nicht via RTTI, sondern man muß selber den Aufbau der Daten deklarieren, aber in der RTTI stehn eh nur die Gesamtgröße des Records und die initialisierbaren Typen. Der Record wird dann praktisch Feld für Feld in einzelnen Nodes abgespeichert.
Delphi-Quellcode:
Dann wurden für die Übersichtlichkeit der Units einige {$REGION}'s eingefügt
TXMLSerializeRDataType = (rtByte, rtWord, rtLongWord, rtWord64, rtShortInt, rtSmallInt, rtLongInt, rtInt64,
rtSingle, rtDouble, rtExtended, rtCurrency, rtDateTime, rtBoolean, rtBOOL, rtAnsiCharArray, rtWideCharArray, rtShortString, rtAnsiString, rtWideString, rtUnicodeString, rtBinar, rtVariant, rtObject, rt_Record, rt_Array, rt_DynArray); PXMLSerializeRecordInfo = ^TXMLSerializeRecordInfo; TXMLSerializeRecordInfo = Array of Record DType: TXMLSerializeRDataType; Elements: Integer; // for rtAnsiCharArray, rtWideCharArray, rtShortString, rtArrayOfByte and rt_Array SubInfo: PXMLSerializeRecordInfo; // for rt_Record, rtArray and rtDynArray End; TXMLNode = Class ... Procedure Serialize (Const V: Variant); Overload; Procedure DeSerialize (Var V: Variant); Overload; Procedure Serialize (C: TObject; SOptions: TXMLSerializeOptions = []; Proc: TXMLSerializeProc = nil); Procedure DeSerialize (C: TObject; SOptions: TXMLSerializeOptions = []; Proc: TXMLDeserializeProc = nil; CreateProc: TXMLClassCreateProc = nil); Function Serialize (Const Rec; Const RecInfo: TXMLSerializeRecordInfo; Align: Integer = 1 {packed <= 1}): Integer; Function DeSerialize (Var Rec; Const RecInfo: TXMLSerializeRecordInfo; Align: Integer = 1 {packed <= 1}): Integer; End; und die Tools-Unit überarbeitet. Dort sind jetzt auch mal die Grundzüge einer DB-Schnittstelle drinnen (aber deren Fertigstellung wird noch dauern, auch wenn das auslesen des Results schon soweit fertig ist ... nur kann man die "DB" noch nicht verwalten und Anfragen senden ... es ist soweit im Stil von mySQL aus PHP gehalten ...
Delphi-Quellcode:
... und ich versuch grad noch ein paar Grundfunktion in 'ner Art API-Funktionen da reinzubekommen)
TXMLDatabase = Class
Constructor Create (Const FileName: TWideString = ''); Destructor Destroy; Override; Property CaseSensitive: Boolean Read GetCaseSensitive Write SetCaseSensitive; Function Connect (Const FileName: TWideString): Boolean; // mysql_connect Function ListTables: TWideStringArray; // mysql_list_tables Function ListFields (Const TableName: TWideString): TWideStringArray; // mysql_list_fields Procedure Flush; // - Procedure Close (Save: Boolean = True); // mysql_close Function AffectedRows: Integer; // mysql_affected_rows Function Stat: TSimpleAssocVariantArray; // mysql_stat Function Error: TWideString; // mysql_error Function Query (Const Query: TWideString): TXMLDBResult; // mysql_query Function NumFields (Const DBResult: TXMLDBResult): Integer; // mysql_num_fields Function NumRows (Const DBResult: TXMLDBResult): Integer; // mysql_num_rows Procedure FreeResult (Var DBResult: TXMLDBResult); // mysql_free_result Function DataSeek (Var DBResult: TXMLDBResult; Offset: Integer): Boolean; // mysql_data_seek Function FetchRow (Var DBResult: TXMLDBResult; Var A: TSimpleAssocVariantArray): Boolean; // mysql_fetch_row Function FetchField (Var DBResult: TXMLDBResult; Offset: Integer = -1): TSimpleAssocVariantArray; // mysql_fetch_field Function FieldTable (Var DBResult: TXMLDBResult; Offset: Integer = -1): TWideString; // mysql_field_table Function FieldName (Var DBResult: TXMLDBResult; Offset: Integer = -1): TWideString; // mysql_field_name Function FieldType (Var DBResult: TXMLDBResult; Offset: Integer = -1): TWideString; // mysql_field_type Function FieldLen (Var DBResult: TXMLDBResult; Offset: Integer = -1): Integer; // mysql_field_len Function FieldSeek (Var DBResult: TXMLDBResult; Offset: Integer): Integer; // mysql_field_seek Function EscapeString (Const UnescapedString: TWideString): TWideString; // mysql_real_escape_string End;
Delphi-Quellcode:
und über die Query-Syntax bin ich mir auch noch nicht ganz einig ... die sieht aktuell so aus:
TXMLDatabase = Class
... Function CreateTable (Const TableName: TWideString; Const Fields {[FieldName, Datatype], ...}: Array of TWideString): Boolean; Overload; Function CreateTable (Const TableName: TWideString; Const Fields {[FieldName, Datatype], ...}, PrimaryKey{FildName, ...}: Array of TWideString): Boolean; Overload; Function AddField (Const TableName, FildName, Datatype: TWideString; AtFirst: Boolean = False; Const AfterField: TWideString = ''): Boolean; Function ChangeField (Const TableName, OldFildName, NewFildName: TWideString; Const NewDatatype: TWideString = ''): Boolean; Function ModifyField (Const TableName, NewDatatype: TWideString): Boolean; Function DropField (Const TableName, FildName: TWideString): Boolean; Function SetPrimaryKey (Const TableName: TWideString; Const Fields: Array of TWideString): Boolean; Function TruncateTable (Const TableName: TWideString): Boolean; Function DropTable (Const TableName: TWideString): Boolean; Function InsertRecord (Const TableName: TWideString; Const Fields {[FieldName, Value], ...}: Array of TWideString): Boolean; Overload; Function InsertRecordDirect(Const TableName: TWideString; Const Values {Value, ...}: Array of TWideString): Boolean; Function InsertRecord (Const TableName: TWideString; Const Select, Condition): Boolean; Overload; Function UpdateRecord (Const TableName: TWideString; Const Fields {[FieldName, Value], ...}: Array of TWideString; Const Condition): Boolean; Function UpdateRecordDirect(Const TableName: TWideString; Const Values {Value, ...}: Array of TWideString; Const Condition): Boolean; Function SelectRecord (Const Select; Var DBResult: TXMLDBResult): Boolean; Function DeleteRecord (Const TableName: TWideString; Const Condition): Boolean; End;
Code:
CREATE TABLE table (field datatyp [, field datatyp [, ...]]
[PRIMARY KEY (field [, field [, ...]])] [FOREIGN KEY (field) REFERENCES extTable(extField)] ) ALTER TABLE table [ ADD field datatyp [{FIRST|AFTER posField}] [, field datatyp [{FIRST|AFTER posField}] [, ...]] [PRIMARY KEY (field [, field [, ...]])] ] [ DROP field [, field [, ...]] ] [ CHANGE field newField [newDatatyp] [, field newField [newDatatyp] [, ...]] ] [ MODIFY field newDatatyp [, field newDatatyp [, ...]] ] TRUNCATE TABLE table DROP TABLE table INSERT INTO table (field [, field [, ...]]) [ VALUES (value [, value [, ...]]) ] [ SELECT ...{see SELECT}... ] UPDATE table SET field = value [, field = value [, ...]] WHERE condition [{AND|OR} condition [...]] SELECT [DISTINCT] field [, field [, ...]] FROM table [WHERE condition [{AND|OR} condition [...]] [OUTER JOIN]] [GROUP BY field] [HAVING condition] [ORDER BY field [{ASC|DESC}]] [{UNION [ALL]|INTERSECT|MINUS} [ SELECT ...{see SELECT}... ]] DELETE FROM table WHERE condition [{AND|OR} condition [...]] table (SELECT): table as tableAlias field (SELECT): {[DISTINCT] COUNT|SUM|MIN|MAX|AVR|CONCAT|TRIM|LTRIM|RTRIM}(field) field as fieldAlias condition: {field|value} {<|<=|=|>=|>|<>|LIKE} {field|value} {field|value} IN ({field|value}, {field|value} [, ...]) {field|value} BETWEEN {field|value} AND {field|value} Dateien siehe Post #1 |
Re: himXML (gesprochen himixML)
Soooooo,
endlich ist auch mal ein Parser drin, auch wenn der noch extrem langsam arbeitet (15 sekunden für schlappe ~200.000 Tags ist nicht wirklich flott, aber er arbeitet erstmal :stupid: ) Demnach ist bis auf das Deserialisieren von Records und Objekten und die DB-Engine der Tools, erstmal alles soweit "funktionsfähig". Anhang siehe Post #1 PS: wisst ihr wieviele Stunden man einen Fehler (auch noch erstmal an falscher Stelle) suchen kann? Zitat:
[edit] ich lad das jetzt nicht extra hoch einfach diesen Wert für FileBufferSize eintragen
Delphi-Quellcode:
und das Lesen geht schneller
Const FileBufferSize = 1024;
allerdings versteh ich grad noch nicht, warum es da plötzlich schneller wird, obwohl so eigentlich öfters umkopiert und nachgeladen werden muß :gruebel: nja, so sind es statt 15-17 Sekunden nur noch 1,2 :shock: |
Re: himXML (gesprochen himixML)
Code:
fill TXMLFile with 100.000 nodes and save into and load this from a file
create:0 fill:170 save:77 free:37 create:0 load:240 free:30 fill TXMLDocument with 100.000 nodes and save into and load this from a file create:3 fill:735228 save:208 free:0 create:0 load:332 free:91 Anhang siehe Post #1[todo] fehlende Deserialisierungen fertigstellen (Object und Record) DB-Engine der Tools weiterplanen sonst läuft anscheinend erstmal alles Andere :-D |
Re: himXML (gesprochen himixML)
Interessantes Projekt, besonders weil ich das XML Format eigentlich mag. Aber es lässt sich so schlecht verwenden. Ich werde dein Projekt mal testen ;) Vll. taugt es was :)
MfG xZise |
Re: himXML (gesprochen himixML)
Zitat:
Und wenn es dir dennoch zu schwer ist ... siehe Tools, da kannst du es (fast) wie TIniFile oder TRegistry verwenden, falls des dir leichter fällt. :angel2: Zitat:
neues Update oben
[add] soeben ist noch 'ne weitere Demo (SAXParser.dpr) entstanden ... es ist sowas wie ein SAX-Parser, also die Daten werden schon wärend des Einlesens/Parsens ausgewertet und gleich wieder freigegeben (dieses hab ich einfach in der schon vorhandenen Callback-Funktion gelöst) man kann also auch mal Gigabyte-große Dateien parsen, ohne daß der geladene XML-Baum den RAM vollmacht [/add] SpeedTest.dpr liefert bei mir jetzt dieses Ergebnis
Code:
ich glaub damit kann ich erstmal leben :angel:
SetProcessAffinityMask: OK
use QueryPerformanceCounter precreating used strings - do not create and convert this within the measuring create:43 fill TXMLFile with 10.000 nodes and save this into a file create:0 fill:15 save:9 free:4 fill TXMLDocument with 10.000 nodes and save this into a file create:12 fill:6458 save:108 free:0 fill TXMLFile with 10.000 nodes, delete 8.000 nodes and save this into a file create:0 fill:15 delete:409 save:4 free:0 fill TXMLDocument with 10.000 nodes, delete 8.000 nodes and save this into a file create:0 fill:6303 delete:106310 save:97 free:0 fill TXMLFile with 10.000 nodes with attributes and save this into a file create:0 fill:691 save:386 free:5 fill TXMLDocument with 10.000 nodes with attributes and save this into a file create:0 fill:6589 save:122 free:0 fill TXMLFile with 100.000 nodes, save into and load this from a file create:0 fill:166 save:70 free:37 create:0 load:245 free:33 fill TXMLDocument with 100.000 nodes, save into and load this from a file create:0 fill:708145 save:348 free:0 create:0 load:331 free:94 fill TXMLFile with 10.000 nodes with attributes and search nodes create:0 fill:697 search:2746 free:4 fill TXMLDocument with 10.000 nodes with attributes and search nodes create:0 fill:6503 search:164476 free:0 press [enter] |
Re: himXML (gesprochen himixML)
Zitat:
MfG xZise |
Re: himXML (gesprochen himixML)
Zitat:
und man gleich loslegen :angel: dieses für je das gleiche Ergebnis
Delphi-Quellcode:
bzw:
XML := TXMLDocument.Create(nil);
XML.Active := True; XML.Version := '1.0'; XML.StandAlone := 'yes'; XML.Encoding := 'UTF-8'; XML.Options := [doNodeAutoIndent]; XML.AddChild('xml'); Node := XML.DocumentElement.AddChild('Node1'); Node.Text := 'Text'; XML.SaveToFile('test.xml'); XML.Free; // gut, das .Free kann man sich sparren, wenn man auf IXMLDocument umsteigt XML := TXMLFile.Create(nil); Node := XML.RootNode.Nodes.Add('Node1'); Node.Data := 'Text'; XML.SaveToFile('test.xml'); XML.Free; // oder gleich so ... XML := TXMLFile.Create(nil); XML.RootNode.Nodes['Node1'].Data := 'Text'; XML.SaveToFile('test.xml'); XML.Free;
Delphi-Quellcode:
für
XML := TXMLFile.Create(nil);
XML.RootNode.Nodes['Node1\Node2'].Data := 'Text 1'; XML.RootNode.Nodes['Node1\Node3'].Data := 'Text 2'; XML.RootNode.Nodes['Node4'].Data := 'Text 3'; XML.SaveToFile('test.xml'); XML.Free;
XML-Code:
per Standard werden (bis auf Kommentare) alle Steuer-Tags (ala <?...?> , <!...> und <![CDATA[...]]> ) rausgefiltert und (bis auf die ungefilterten NF-Funktionen) im Baum nicht aufgelistet. (siehe XML.Options)
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<xml> <Node1> <Node2>Text 1</Node2> <Node3>Text 2</Node3> </Node1> <Node4>Text 3</Node4> </xml> ja und wenn es wirklich einfach sein soll ... nja, ist quasi eine INI im XML-Format :nerd:
Delphi-Quellcode:
Var Ini: TXMLIniFile;
Ini := TXMLIniFile.Create('myOptions.xml'); Try Ini.WriteString('Section', 'Ident 1', S); Finally Ini.Free; End;
XML-Code:
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<ini> <section name="Section"> <ident name="Ident 1">irgendein String</ident> </section> </ini> hab auch grad 'nen Fehler beim AutoUpdate der XML-Ini entdeckt (kleine Exception beim .Free) und gleich noch eine Parameterprüfung dort mit eingebaut wird beim nächsten Update mit hochgeladen |
Re: himXML (gesprochen himixML)
die dort drüben aufgetauchte Exception wurde behoben
> Schnelle XML Lib für große Dateien gesucht #35(kleiner Fehler beim Nachladen wärend ein Attribut ausgelesen wurde)
Code:
also 10,7 Minuten für 12.000.006 Tags und Attribute einer 386 MB-Datei
fill TXMLFile with 4.000.000 nodes, save into and load this from a file
create:0 fill:413022 save:404106 free:3261 create:0 load:643563 free:3104 fill TXMLDocument with 4.000.000 nodes, save into and load this from a file ... Im "pseudo" SAX-Mode wird in der Demo (SpeedTest.dpr) eine belibig große Datei mit nur 3 MB RAM innerhalb von 12 Minuten (0,5 MB/s) ausgelesen (also abzüglich der precreated-Arrays für die anderen Tests). OK, ist nicht wirklich schnell, aber es ist ja auch 'ne DOM-Lib Aktuell bin ich erstmal froh, daß es soweit läuft und Optimierungspotential gibt es noch (pro Byte zwei Funktionsaufrufe ... aber erstmal andere Fehler entdecken und dann kommt das dran) [add] die Demo_Tree.exe bitte neu komilieren, sonst kommt es noch zur obengenannten exception, bei Dateien über 64 KB alles neu kompiliert |
Re: himXML (gesprochen himixML)
Zitat:
Code:
In XML sähe das dann so aus:
computers.count=1
computers[0].name=Hallo computers[0].LastIPByte=101 computers[0].Left=100 computers[0].Top=25
Code:
Da ließe sich bestimmt noch einiges verbessern (mit Attributen z.B.) ... Aber genau aus diesem Grund möchte ich ja mal deine Unit testen, wobei ich im Moment noch nicht weiß wo (außer im obigen Beispiel... Aber da sind die Daten auf einen Computer in der Schule) :)
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<xml> <Computers> <Computer> <Name>Hallo</Name> <LastIPByte>101</LastIPByte> <Position> <Left>100</Left> <Top>25</Top> </Position> </Computer> </Computers> </xml> MfG xZise |
Re: himXML (gesprochen himixML)
entweder du probierst es mal mit der Serialisierung (Beispiele siehe Projekt Demo_Serialize).
> dieses speichert aber bei Objekten nur published Properties (für "alles" Andere bietet mir Delphi keine oder nur unzureichende Informationen) z.B. so in dieser Art:
Delphi-Quellcode:
oder du machst es selber, was aber auch nicht sooooo schwer ist
XML := TXMLFile.Create;
Try XML.RootNode.AddNode('Computers').Serialize(Computers, ....); XML.SaveToFile('Computers.xml'); Finally XML.Free; End; XML := TXMLFile.Create; Try XML.LoadFromFile('Computers.xml'); XML.RootNode.AddNode('Computers').Deserialize(Computers, ....); Finally XML.Free; End; dieses ergibt dein XML-Beispiel (nur noch mit dem Count-Node):
XML-Code:
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<xml> <Computers> <Count>1</Count> <Computer> <Name>Hallo</Name> <LastIPByte>101</LastIPByte> <Position> <Left>100</Left> <Top>25</Top> </Position> </Computer> </Computers> </xml>
Delphi-Quellcode:
und mit Attributen:
// Speichern
XML := TXMLFile.Create; Try XML.RootNode.AddNode('Computers\Count').Data := Computers.Count; For i := 0 to Computers.Count - 1 do With XML.RootNode.AddNode('Computers\Computer') do Begin AddNode('Name').Data := Computers[i].Name; AddNode('LastIPByte').Data := Computers[i].LastIPByte; AddNode('Position\Left').Data := Computers[i].Left; AddNode('Position\Top').Data := Computers[i].Top; End; XML.SaveToFile('Computers.xml'); Finally XML.Free; End; // laden XML := TXMLFile.Create; Try XML.LoadFromFile('Computers.xml'); Computers.Count := XML.RootNode.Node['Computers\Count'].Data; For i := 0 to Computers.Count - 1 do With XML.RootNode.NodeList['Computers\Computer'][i] do Begin Computers[i].Name := Node['Name'].Data; Computers[i].LastIPByte := Node['LastIPByte'].Data; Computers[i].Left := Node['Position\Left'].Data; Computers[i].Top := Node['Position\Top'].Data; End; Finally XML.Free; End;
XML-Code:
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<xml> <Computers Count="1"> <Computer Name="Hallo" LastIPByte="101" Left="100" Top="25"> </Computers> </xml>
Delphi-Quellcode:
man könnte auch Count weglassen und zählen:
// Speichern
XML := TXMLFile.Create; Try XML.RootNode.AddNode('Computers').Attributes['Count'] := Computers.Count; For i := 0 to Computers.Count - 1 do With XML.RootNode.AddNode('Computers\Computer') do Begin Attribute['Name'] := Computers[i].Name; Attribute['LastIPByte'] := Computers[i].LastIPByte; Attribute['Left'] := Computers[i].Left; Attribute['Top'] := Computers[i].Top; End; XML.SaveToFile('Computers.xml'); Finally XML.Free; End; // laden XML := TXMLFile.Create; Try XML.LoadFromFile('Computers.xml'); Computers.Count := XML.RootNode.Node['Computers'].Attribute['Count']; For i := 0 to Computers.Count - 1 do With XML.RootNode.NodeList['Computers\Computer'][i] do Begin Computers[i].Name := Attribute['Name']; Computers[i].LastIPByte := Attribute['LastIPByte']; Computers[i].Left := Attribute['Left']; Computers[i].Top := Attribute['Top']; End; Finally XML.Free; End;
Delphi-Quellcode:
ich hoff mal, es ist jetzt nicht zu schwer?
// Speichern
XML := TXMLFile.Create; Try For i := 0 to Computers.Count - 1 do With XML.RootNode.AddNode('Computers\Computer') do Begin ... End; XML.SaveToFile('Computers.xml'); Finally XML.Free; End; // laden XML := TXMLFile.Create; Try XML.LoadFromFile('Computers.xml'); Computers.Count := Length(XML.RootNode.Node['Computers'].NodeList['Computer']); For i := 0 to Computers.Count - 1 do With XML.RootNode.NodeList['Computers\Computer'][i] do Begin ... End; Finally XML.Free; End; // laden 2 (wenn es eh keine anderen Subnodes im Node "Computers" gibt) XML := TXMLFile.Create; Try XML.LoadFromFile('Computers.xml'); Computers.Count := XML.RootNode.Node['Computers'].Nodes.Count; For i := 0 to Computers.Count - 1 do With XML.RootNode.Node['Computers'].Node[i] do Begin ... End; Finally XML.Free; End; |
Re: himXML (gesprochen himixML)
XML-Code:
Was mir da gerade auffällt ist der enorme Overhead. Bei XML gibt es ja auch Komprimierung, ist da was für himXML geplant (evtl. halt erst in späteren Versionen).
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<xml> <Computers> <Count>1</Count> <Computer> <Name>Hallo</Name> <LastIPByte>101</LastIPByte> <Position> <Left>100</Left> <Top>25</Top> </Position> </Computer> </Computers> </xml> |
Re: himXML (gesprochen himixML)
Wenn du die Zeilenumbrüche und Einrückung meinst ... nimm einfach xoNodeAutoIndent aus den Optionen (.Options) raus :angel:
PS: die CDATA-Sektion wird seit vorgestern standardmäßig nicht mehr umgebrochen (diese hat, zusammen mit den Unknown-Nodes, eine eigene Behandlung bekommen) hierfür gibt es also xoNodeAutoIndent, xoCDataNotAutoIndent und xoFullEmptyElements insgesamt gibt es derzeit (die Fettgedruckten sind standardmäßig aktiv)
man kann den Standard aber allerdings über TXMLFile.DefaultOptions global für alle nachfolgend erstellten TXMLFile-Instanzen ändern |
Re: himXML (gesprochen himixML)
Hmm, bekomme es jetzt mit TDE2006 nicht mehr compiliert und leider immer brav die alte Version gelöscht. :gruebel:
Geht schon bei __CompareBlock los (Char <> WideChar). Du hast ja selber TDE2006, falls nicht poste ich eine genauere Fehlermeldung. |
| Alle Zeitangaben in WEZ +1. Es ist jetzt 22:03 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz