 |
 |
 |
 |
 |
|
Antwort
|
Registriert seit: 11. Okt 2003
wollt eigentlich nur mal die ersten Fortschritte eines vor kurzem längerem begonnen Projektes vorstellen
 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.  [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  [add 13.03.2009] ach ja falls der Name jemandem nich gefällt ... Beschwerden bitte an Matze richten  [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)
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat, wird PoSex im Delphi viel seltener praktiziert. Geändert von himitsu (30. Dez 2010 um 09:29 Uhr) |
Delphi 3 Professional |
#3
13. Mär 2009, 15:41
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  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
Frank Wunderlich
|
Zitat
|
|
Delphi 12 Athens |
#4
13. Mär 2009, 16:26
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? 
|
|
Zitat
|
|
Delphi 3 Professional |
#5
13. Mär 2009, 16:32
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
Frank Wunderlich
|
|
Zitat
|
|
Delphi 12 Athens |
#6
31. Mär 2009, 18:43
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  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
TXMLNode = Class
Property Attributes: TXMLAttributes Read _Attributes Write AssignAttributes; Property Nodes: TXMLNodeList Read _Nodes Write AssignNodes;
|
|
Zitat
|
|
Delphi 12 Athens |
#8
31. Mär 2009, 20:40
Zitat von bigg:
nette Idee. Wirst du auch die Serialisierung von Objekten und Objekt-Strukturen in deiner Klasse unterstützen?
hatte ich zwar noch nicht dran gedacht, aber möglich wär's 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> |
|
Zitat
|
|
Delphi 12 Athens |
#9
1. Apr 2009, 14:10
hab mal schnell ein Serialize angefangen und joar ... werd' es wohl drinlassen und später weitermachen
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. |
|
Zitat
|
|
|
#10
1. Apr 2009, 14:16
Zitat von _frank_:
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 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 Es ist mir viel lieber als Delphi 3, das ich bis vor ca. 9 Monaten auch verwendet habe. mfg Florian |
|
Zitat
|
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
| Erstellt von | For | Type | Datum |
| xml - MSXML alternative - Stack Overflow | This thread | Refback | 28. Jun 2011 16:34 |
bei der Objektversion sind die Exceptions noch nicht umgeleitet, also möglichst welche vermeiden 
Linear-Darstellung
