Changeset 75 for trunk/Packages/Common/XML.pas
- Timestamp:
- Jun 4, 2024, 12:22:49 AM (5 months ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/XML.pas
r74 r75 1 unit UXMLUtils; 2 3 {$mode delphi} 1 unit XML; 4 2 5 3 interface … … 7 5 uses 8 6 {$IFDEF WINDOWS}Windows,{$ENDIF} 9 Classes, SysUtils, DateUtils ;7 Classes, SysUtils, DateUtils, DOM, xmlread; 10 8 11 9 function XMLTimeToDateTime(XMLDateTime: string): TDateTime; 12 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString; 10 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string; 11 procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer); 12 procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64); 13 procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean); 14 procedure WriteString(Node: TDOMNode; Name: string; Value: string); 15 procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime); 16 procedure WriteDouble(Node: TDOMNode; Name: string; Value: Double); 17 function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer; 18 function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64; 19 function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean; 20 function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string; 21 function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime; 22 function ReadDouble(Node: TDOMNode; Name: string; DefaultValue: Double): Double; 23 procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string); 13 24 14 25 15 26 implementation 27 28 function ReadDouble(Node: TDOMNode; Name: string; DefaultValue: Double): Double; 29 var 30 NewNode: TDOMNode; 31 begin 32 Result := DefaultValue; 33 NewNode := Node.FindNode(DOMString(Name)); 34 if Assigned(NewNode) then 35 Result := StrToFloat(string(NewNode.TextContent)); 36 end; 37 38 procedure ReadXMLFileParser(out Doc: TXMLDocument; FileName: string); 39 var 40 Parser: TDOMParser; 41 Src: TXMLInputSource; 42 InFile: TFileStream; 43 begin 44 try 45 InFile := TFileStream.Create(FileName, fmOpenRead); 46 Src := TXMLInputSource.Create(InFile); 47 Parser := TDOMParser.Create; 48 Parser.Options.PreserveWhitespace := True; 49 Parser.Parse(Src, Doc); 50 finally 51 Src.Free; 52 Parser.Free; 53 InFile.Free; 54 end; 55 end; 16 56 17 57 function GetTimeZoneBias: Integer; … … 20 60 TimeZoneInfo: TTimeZoneInformation; 21 61 begin 62 {$push}{$warn 5057 off} 22 63 case GetTimeZoneInformation(TimeZoneInfo) of 23 TIME_ZONE_ID_STANDARD: Result := TimeZoneInfo.Bias + TimeZoneInfo.StandardBias;24 TIME_ZONE_ID_DAYLIGHT: Result := TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias;64 TIME_ZONE_ID_STANDARD: Result := TimeZoneInfo.Bias + TimeZoneInfo.StandardBias; 65 TIME_ZONE_ID_DAYLIGHT: Result := TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias; 25 66 else 26 67 Result := 0; 27 68 end; 69 {$pop} 28 70 end; 29 71 {$ELSE} … … 35 77 function LeftCutString(var Source: string; out Output: string; Delimiter: string; Allowed: string = ''): Boolean; 36 78 var 37 I , J: Integer;79 I: Integer; 38 80 Matched: Boolean; 39 81 begin … … 66 108 Minute: Integer; 67 109 Second: Integer; 110 SecondFraction: Double; 68 111 Millisecond: Integer; 69 112 begin … … 88 131 if Pos('Z', XMLDateTime) > 0 then 89 132 LeftCutString(XMLDateTime, Part, 'Z'); 90 Millisecond := StrToInt(Part); 133 SecondFraction := StrToFloat('0' + DefaultFormatSettings.DecimalSeparator + Part); 134 Millisecond := Trunc(SecondFraction * 1000); 91 135 end else begin 92 136 if Pos('+', XMLDateTime) > 0 then … … 106 150 end; 107 151 108 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;152 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): string; 109 153 const 110 154 Neg: array[Boolean] of string = ('+', '-'); … … 123 167 end; 124 168 169 procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer); 170 var 171 NewNode: TDOMNode; 172 begin 173 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 174 NewNode.TextContent := DOMString(IntToStr(Value)); 175 Node.AppendChild(NewNode); 176 end; 177 178 procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64); 179 var 180 NewNode: TDOMNode; 181 begin 182 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 183 NewNode.TextContent := DOMString(IntToStr(Value)); 184 Node.AppendChild(NewNode); 185 end; 186 187 procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean); 188 var 189 NewNode: TDOMNode; 190 begin 191 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 192 NewNode.TextContent := DOMString(BoolToStr(Value)); 193 Node.AppendChild(NewNode); 194 end; 195 196 procedure WriteString(Node: TDOMNode; Name: string; Value: string); 197 var 198 NewNode: TDOMNode; 199 begin 200 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 201 NewNode.TextContent := DOMString(Value); 202 Node.AppendChild(NewNode); 203 end; 204 205 procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime); 206 var 207 NewNode: TDOMNode; 208 begin 209 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 210 NewNode.TextContent := DOMString(DateTimeToXMLTime(Value)); 211 Node.AppendChild(NewNode); 212 end; 213 214 procedure WriteDouble(Node: TDOMNode; Name: string; Value: Double); 215 var 216 NewNode: TDOMNode; 217 begin 218 NewNode := Node.OwnerDocument.CreateElement(DOMString(Name)); 219 NewNode.TextContent := DOMString(FloatToStr(Value)); 220 Node.AppendChild(NewNode); 221 end; 222 223 function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer; 224 var 225 NewNode: TDOMNode; 226 begin 227 Result := DefaultValue; 228 NewNode := Node.FindNode(DOMString(Name)); 229 if Assigned(NewNode) then 230 Result := StrToInt(string(NewNode.TextContent)); 231 end; 232 233 function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64; 234 var 235 NewNode: TDOMNode; 236 begin 237 Result := DefaultValue; 238 NewNode := Node.FindNode(DOMString(Name)); 239 if Assigned(NewNode) then 240 Result := StrToInt64(string(NewNode.TextContent)); 241 end; 242 243 function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean; 244 var 245 NewNode: TDOMNode; 246 begin 247 Result := DefaultValue; 248 NewNode := Node.FindNode(DOMString(Name)); 249 if Assigned(NewNode) then 250 Result := StrToBool(string(NewNode.TextContent)); 251 end; 252 253 function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string; 254 var 255 NewNode: TDOMNode; 256 begin 257 Result := DefaultValue; 258 NewNode := Node.FindNode(DOMString(Name)); 259 if Assigned(NewNode) then 260 Result := string(NewNode.TextContent); 261 end; 262 263 function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime 264 ): TDateTime; 265 var 266 NewNode: TDOMNode; 267 begin 268 Result := DefaultValue; 269 NewNode := Node.FindNode(DOMString(Name)); 270 if Assigned(NewNode) then 271 Result := XMLTimeToDateTime(string(NewNode.TextContent)); 272 end; 273 125 274 end. 126
Note:
See TracChangeset
for help on using the changeset viewer.