david
fff1b2a4dc
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.SDAC@3 6f543ec7-021b-7e4c-98c9-62eafc7fb9a8
1019 lines
26 KiB
ObjectPascal
1019 lines
26 KiB
ObjectPascal
|
|
//////////////////////////////////////////////////
|
|
// DB Access Components
|
|
// Copyright © 1998-2007 Core Lab. All right reserved.
|
|
// CRXml
|
|
//////////////////////////////////////////////////
|
|
|
|
unit CRXml;
|
|
|
|
interface
|
|
|
|
{$I Dac.inc}
|
|
uses
|
|
Classes, SysUtils, Contnrs, CLRClasses;
|
|
|
|
type
|
|
|
|
TChars = array of char;
|
|
|
|
TextReader = class
|
|
end;
|
|
|
|
StreamReader = class(TextReader)
|
|
private
|
|
FReader: TStream;
|
|
FCapacity: Integer;
|
|
FReleaseReader: Boolean;
|
|
function Eof: Boolean;
|
|
public
|
|
constructor Create(const path: string; detectEncodingFromByteOrderMarks: Boolean); overload;
|
|
constructor Create(input: TStream); overload;
|
|
destructor Destroy; override;
|
|
procedure Close;
|
|
function Read(buffer: TChars; Index, Count: Integer):Integer;
|
|
function ReadLine:string;
|
|
function ReadToEnd:string;
|
|
|
|
property BaseStream: TStream read FReader;
|
|
end;
|
|
|
|
StringReader = class(TextReader)
|
|
private
|
|
FText: string;
|
|
public
|
|
constructor Create(Text: string);
|
|
end;
|
|
|
|
StreamWriter = class
|
|
private
|
|
FWriter: TStream;
|
|
FReleaseWriter: Boolean;
|
|
FEncodingClass: EncodingClass;
|
|
public
|
|
constructor Create(const path: string; Append: Boolean); overload;
|
|
constructor Create(output: TStream; Encoding: EncodingClass); overload;
|
|
destructor Destroy; override;
|
|
|
|
procedure Close;
|
|
procedure Flush;
|
|
procedure Write(value: string);
|
|
procedure WriteLine(const value: string);
|
|
end;
|
|
|
|
XmlException = class(Exception);
|
|
|
|
XmlNodeType = (ntNone, ntElement, ntAttribute, ntEndElement, ntComment, ntDeclaration, ntDocumentType, ntText);
|
|
XmlReadState = (Initial, Interactive, Error, EndOfFile, Closed);
|
|
|
|
XmlTextReader = class
|
|
private
|
|
FText: string;
|
|
FTextlc: string;
|
|
FPrefix: string;
|
|
FValue: string;
|
|
FName: string;
|
|
FNodeType: XmlNodeType;
|
|
FAttrNames: TStringList;
|
|
FAttrPrefix: TStringList;
|
|
FAttrValues: TStringList;
|
|
FOffset: Integer;
|
|
FTextLen: Integer;
|
|
FState: XmlReadState;
|
|
FCurrElementName: string;
|
|
FReader: StreamReader;
|
|
FEof: Boolean;
|
|
function GetHasAttributes: Boolean;
|
|
function GetDepth: integer;
|
|
function GetAttributeCount: integer;
|
|
procedure GetXMLNodeAttributes(const Node: string; AttrNames: TStrings;
|
|
AttrValues: TStrings);
|
|
procedure ReadFromStream;
|
|
procedure InitInstance;
|
|
function GetEof:Boolean;
|
|
protected
|
|
function ScanLine(Lexem: array of string; Offset: Integer = -1):Boolean;
|
|
public
|
|
constructor Create(Reader: TextReader);
|
|
destructor Destroy; override;
|
|
|
|
procedure MoveToAttribute(i: integer); overload;
|
|
function MoveToAttribute(name: string):Boolean; overload;
|
|
function Read: boolean;
|
|
function MoveToElement: boolean;
|
|
function Items(const Index: Integer): string; overload;
|
|
function Items(const AttrName: string): string; overload;
|
|
|
|
property Name: string read FName;
|
|
property Prefix: string read FPrefix;
|
|
property Value: string read FValue;
|
|
property NodeType: XmlNodeType read FNodeType;
|
|
property AttributeCount: integer read GetAttributeCount;
|
|
property Depth: integer read GetDepth;
|
|
property ReadState: XmlReadState read FState;
|
|
property Eof: Boolean read FEof;
|
|
property HasAttributes: Boolean read GetHasAttributes;
|
|
end;
|
|
|
|
XmlFormatting = (fmtNone, fmtIndented);
|
|
XmlWriteState = (wsAttribute, wsClosed, wsContent, wsElement, wsStart);
|
|
|
|
XmlTextWriter = class
|
|
private
|
|
FText: string;
|
|
FFormatting: XmlFormatting;
|
|
FIndentation: Integer;
|
|
FIndentChar: Char;
|
|
FQuoteChar: Char;
|
|
FWriteState: XmlWriteState;
|
|
FDepth: Integer;
|
|
FPrefix: TStringList;
|
|
FPosStack: TStack;
|
|
FTagStack: TStringList;
|
|
FWriter: StreamWriter;
|
|
function IndentStr: string;
|
|
function PopTagName: string;
|
|
procedure PushTagName(const TagName: string);
|
|
procedure InternalCloseStartTag;
|
|
protected
|
|
procedure InternalWriteStartElement(const Prefix, LocalName, ns: string);
|
|
procedure InternalWriteElementString(const LocalName, ns, Value: string);
|
|
procedure InternalWriteAttributeString(const Prefix, LocalName, ns, Value: string);
|
|
procedure InternalWriteEndElement;
|
|
procedure FlushData;
|
|
public
|
|
constructor Create(w: StreamWriter);
|
|
destructor Destroy; override;
|
|
|
|
procedure WriteStartElement(const LocalName: string); overload;
|
|
procedure WriteStartElement(const Prefix, LocalName, ns: string); overload;
|
|
procedure WriteStartElement(const LocalName, ns: string); overload;
|
|
procedure WriteEndElement;
|
|
procedure WriteFullEndElement;
|
|
procedure WriteString(const Text: string);
|
|
procedure WriteElementString(const LocalName, ns, value: string); overload;
|
|
procedure WriteElementString(const LocalName, Value: string); overload;
|
|
|
|
procedure WriteAttributeString(const LocalName, Value: string); overload;
|
|
procedure WriteAttributeString(const Prefix, LocalName, ns, Value: string); overload;
|
|
procedure Close;
|
|
|
|
property Formatting: XmlFormatting read FFormatting write FFormatting;
|
|
property Indentation: Integer read FIndentation write FIndentation;
|
|
property IndentChar: Char read FIndentChar write FIndentChar;
|
|
property QuoteChar: Char read FQuoteChar write FQuoteChar;
|
|
property WriteState: XmlWriteState read FWriteState;
|
|
end;
|
|
|
|
implementation
|
|
uses
|
|
{$IFDEF VER7P}
|
|
StrUtils,
|
|
{$ENDIF}
|
|
MemUtils, CRParser;
|
|
|
|
const
|
|
LineSeparator = #13#10;
|
|
SInvalidXML = 'Invalid XML';
|
|
SClassNotSupported = 'Class %s is not supported';
|
|
|
|
procedure DeleteInvisibleSymbol(var s: string); forward;
|
|
function XMLDecode(const AStr: String): String; forward;
|
|
function CompareLexem(const s, Substr: string; Index: Integer):Boolean; forward;
|
|
|
|
type
|
|
TXmlParser = class(TParser)
|
|
public
|
|
constructor Create(const Text: string); override;
|
|
end;
|
|
|
|
var
|
|
XmlSymbolLexems, XmlKeywordLexems: TStringList;
|
|
|
|
{ XmlTextReader }
|
|
|
|
constructor XmlTextReader.Create(Reader: TextReader);
|
|
begin
|
|
inherited Create;
|
|
|
|
|
|
if Reader.InheritsFrom(StreamReader) then begin
|
|
FTextLen := -1;
|
|
FReader := StreamReader(Reader);
|
|
ReadFromStream;
|
|
end
|
|
else
|
|
if Reader.InheritsFrom(StringReader) then begin
|
|
FReader := nil;
|
|
FText := StringReader(Reader).FText;
|
|
FTextLen := Length(FText);
|
|
FTextlc := LowerCase(FText);
|
|
end
|
|
else
|
|
raise Exception.CreateFmt(SClassNotSupported, [Reader.ClassName]);
|
|
InitInstance;
|
|
end;
|
|
|
|
destructor XmlTextReader.Destroy;
|
|
begin
|
|
FAttrNames.Free;
|
|
FAttrPrefix.Free;
|
|
FAttrValues.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure XmlTextReader.ReadFromStream;
|
|
begin
|
|
if Assigned(FReader) then begin
|
|
if (FOffset >= FTextLen) then begin
|
|
if not FReader.Eof then begin
|
|
FText := '';
|
|
repeat
|
|
FText := FText + ' ' + TrimRight(FReader.ReadLine);
|
|
until (Pos('>', FText) <> 0) or FReader.Eof;
|
|
FTextlc := LowerCase(FText);
|
|
FTextLen := Length(FText);
|
|
FOffset := 1;
|
|
end
|
|
else
|
|
FEof := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function XmlTextReader.MoveToElement: boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function XmlTextReader.ScanLine(Lexem: array of string; Offset: Integer = -1):Boolean;
|
|
var
|
|
i: Integer;
|
|
Str: string;
|
|
begin
|
|
ReadFromStream;
|
|
Result := False; // Make compiler happy;
|
|
if Offset <> -1 then
|
|
FOffset := Offset;
|
|
while (FOffset <= FTextLen) do begin
|
|
Result := False;
|
|
for i := Low(Lexem) to High(Lexem) do begin
|
|
Str := Copy(FTextlc, FOffset, Length(Lexem[i]));
|
|
if Str = Lexem[i] then begin
|
|
Result := True;
|
|
inc(FOffset, Length(Lexem[i]));
|
|
break;
|
|
end;
|
|
end;
|
|
if Result then
|
|
break;
|
|
inc(FOffset);
|
|
end;
|
|
|
|
if (not Result) and (not GetEof) then
|
|
Result := ScanLine(Lexem);
|
|
end;
|
|
|
|
function XmlTextReader.Read: boolean;
|
|
var
|
|
Node: string;
|
|
NextLexem: Integer;
|
|
OldOffset: Integer;
|
|
EndTagName: string;
|
|
ChildTag: Integer;
|
|
k: Integer;
|
|
IsTextFound: Boolean;
|
|
begin
|
|
Result := False;
|
|
ReadFromStream;
|
|
|
|
if (FState in [Initial, Interactive]) then begin
|
|
IsTextFound := False;
|
|
if NodeType = ntElement then begin
|
|
k := FOffset;
|
|
while (FTextlc[k] <> '<') and (k <= Length(FTextlc)) do begin
|
|
if FTextlc[k] in ['a'..'z', '0'..'9', '.', ':'] then begin
|
|
IsTextFound := True;
|
|
break;
|
|
end;
|
|
inc(k);
|
|
end;
|
|
if IsTextFound then begin
|
|
FNodeType := ntText;
|
|
inc(FOffset);
|
|
end;
|
|
end;
|
|
|
|
if not IsTextFound then begin
|
|
if not ScanLine(['<']) then begin
|
|
if Eof then
|
|
exit;
|
|
FState := Error;
|
|
XmlException.Create('Root element missing');
|
|
end;
|
|
if FTextlc[FOffset] = '?' then
|
|
FNodeType := ntDeclaration
|
|
else if CompareLexem(FTextlc, '!--', FOffset) then
|
|
FNodeType := ntComment
|
|
else if CompareLexem(FTextlc, '!DOCTYPE', FOffset) then
|
|
FNodeType := ntDocumentType
|
|
else if FTextlc[FOffset] = '/' then begin
|
|
FNodeType := ntEndElement;
|
|
end
|
|
else if (FTextlc[FOffset-1] = '<') then
|
|
FNodeType := ntElement
|
|
else
|
|
Assert(False);
|
|
end;
|
|
FState := Interactive;
|
|
end;
|
|
|
|
FName := '';
|
|
FValue := '';
|
|
FPrefix := '';
|
|
|
|
case FNodeType of
|
|
ntDeclaration: begin
|
|
inc(FOffset);
|
|
NextLexem := PosEx(' ', FTextlc, FOffset);
|
|
if NextLexem <> -1 then begin
|
|
FName := Trim(Copy(FText, FOffset, NextLexem-FOffset));
|
|
inc(FOffset, NextLexem-FOffset);
|
|
end;
|
|
if ScanLine(['?>']) then
|
|
FValue := Trim(Copy(FText, NextLexem, FOffset-NextLexem-2))
|
|
else begin
|
|
FState := Error;
|
|
raise XmlException.Create('Invalid declaration tag');
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
ntComment: begin
|
|
inc(FOffset, 3);
|
|
NextLexem := FOffset;
|
|
if ScanLine(['-->']) then
|
|
FValue := Trim(Copy(FText, NextLexem, FOffset - NextLexem - 3))
|
|
else begin
|
|
FState := Error;
|
|
raise XmlException.Create('Invalid comment tag');
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
ntDocumentType: begin
|
|
inc(FOffset, 8);
|
|
NextLexem := FOffset;
|
|
if ScanLine(['[<']) then begin
|
|
FName := Trim(Copy(FText, NextLexem, FOffset - NextLexem - 2));
|
|
NextLexem := PosEx('>]', FTextlc, FOffset);
|
|
FValue := Trim(Copy(FText, FOffset, NextLexem - FOffset));
|
|
inc(FOffset, NextLexem - FOffset)
|
|
end
|
|
else begin
|
|
FState := Error;
|
|
raise XmlException.Create('Invalid Document type tag');
|
|
end;
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
ntEndElement: begin
|
|
inc(FOffset);
|
|
NextLexem := PosEx('>', FTextlc, FOffset);
|
|
FName := Trim(Copy(FText, FOffset, NextLexem - FOffset));
|
|
FOffset := NextLexem;
|
|
Result := True;
|
|
end;
|
|
|
|
ntElement: begin
|
|
if FTextlc[FOffset-1] = '<' then begin
|
|
NextLexem := PosEx('>', FTextlc, FOffset);
|
|
Node := Copy(FText, FOffset, NextLexem - FOffset+1);
|
|
|
|
OldOffset := FOffset;
|
|
ScanLine([' ','>']);
|
|
FName := Trim(Copy(FText, OldOffset, FOffset - OldOffset - 1));
|
|
Delete(Node, 1, Length(FName));
|
|
GetXMLNodeAttributes(Node, FAttrNames, FAttrValues);
|
|
|
|
FCurrElementName := FName;
|
|
if FName[Length(FName)] = '/'then
|
|
Delete(FName, Length(FName), 1);
|
|
|
|
FOffset := NextLexem;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
ntText: begin
|
|
EndTagName := LowerCase(FCurrElementName);
|
|
DeleteInvisibleSymbol(EndTagName);
|
|
EndTagname := '</'+EndTagName+'>';
|
|
|
|
if FCurrElementName[Length(FCurrElementName)] = '/' then
|
|
NextLexem := FOffset + Length(FCurrElementName)
|
|
else
|
|
NextLexem := PosEx(EndTagName, FTextlc, FOffset);
|
|
FValue := Trim(Copy(FText,FOffset, NextLexem - FOffset));
|
|
ChildTag := PosEx('<', FValue);
|
|
if (ChildTag <> 0) and (not CompareLexem(FValue, '<!', ChildTag)) then begin // omit <![CDATA
|
|
FValue := Trim(Copy(FValue, 1, ChildTag-1));
|
|
if ChildTag = 1 then
|
|
FOffset := FOffset + ChildTag
|
|
else
|
|
FOffset := FOffset + ChildTag-1;
|
|
|
|
end
|
|
else
|
|
FOffset := NextLexem;
|
|
Result := True;
|
|
end;
|
|
else
|
|
begin
|
|
FState := Error;
|
|
Assert(False);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure XmlTextReader.GetXMLNodeAttributes(const Node: string; AttrNames: TStrings; AttrValues: TStrings);
|
|
var
|
|
Parser: TXmlParser;
|
|
Code: integer;
|
|
Lexem: string;
|
|
AttrName: string;
|
|
AttrValue: string;
|
|
AttrPrefix: string;
|
|
WithColon: boolean;
|
|
begin
|
|
FAttrNames.Clear;
|
|
FAttrValues.Clear;
|
|
FAttrPrefix.Clear;
|
|
Parser := TXmlParser.Create(Node);
|
|
try
|
|
while True do begin
|
|
Code := Parser.GetNext(Lexem);
|
|
case Code of
|
|
lcEnd, 18, 20: // '<', '>'
|
|
break;
|
|
lcIdent: begin
|
|
WithColon := False;
|
|
AttrName := Lexem;
|
|
AttrPrefix := '';
|
|
Code := Parser.GetNext(Lexem);
|
|
if Code = lcIdent then begin
|
|
AttrName := Lexem;
|
|
Code := Parser.GetNext(Lexem);
|
|
end;
|
|
if Code in [16, 19] then begin
|
|
if Code = 16 then begin // ':'
|
|
Code := Parser.GetNext(Lexem);
|
|
if Code <> lcIdent then
|
|
raise XmlException.Create(SInvalidXML);
|
|
AttrPrefix := AttrName;
|
|
AttrName := AttrPrefix + ':' + Lexem;
|
|
Code := Parser.GetNext(Lexem);
|
|
WithColon := True;
|
|
end;
|
|
|
|
if Code = 19 then begin // '='
|
|
Code := Parser.GetNext(Lexem);
|
|
if (Code <> lcIdent) and (Code <> lcString) then
|
|
raise XmlException.Create(SInvalidXML);
|
|
AttrValue := XMLDecode({UTF8Decode}(Lexem));
|
|
if WithColon and (LowerCase(AttrName) = 'name') then
|
|
AttrName := ':' + AttrName;
|
|
AttrNames.Add(AttrName);
|
|
AttrValues.Add(AttrValue);
|
|
FAttrPrefix.Add(AttrPrefix);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Parser.Free;
|
|
end;
|
|
Assert(AttrNames.Count = AttrValues.Count);
|
|
end;
|
|
|
|
function XMLDecode(const AStr: String): String;
|
|
var
|
|
sb: StringBuilder;
|
|
begin
|
|
sb := StringBuilder.Create(AStr, Length(AStr));
|
|
try
|
|
sb.Replace(''', '''');
|
|
sb.Replace('"', '"');
|
|
sb.Replace('<', '<');
|
|
sb.Replace('>', '>');
|
|
sb.Replace('&', '&');
|
|
Result := sb.ToString;
|
|
finally
|
|
sb.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
function XmlTextReader.Items(const Index: Integer): string;
|
|
begin
|
|
Result := FAttrValues[Index];
|
|
end;
|
|
|
|
function XmlTextReader.Items(const AttrName: string): string;
|
|
begin
|
|
Result := Items(FAttrNames.IndexOf(AttrName));
|
|
end;
|
|
|
|
function XmlTextReader.GetAttributeCount: integer;
|
|
begin
|
|
Result := FAttrNames.Count;
|
|
end;
|
|
|
|
procedure XmlTextReader.MoveToAttribute(i: integer);
|
|
begin
|
|
try
|
|
FName := FAttrNames[i];
|
|
FValue := FAttrValues[i];
|
|
FPrefix := FAttrPrefix[i];
|
|
except
|
|
raise XmlException.Create(Format('Attribute not found (%d)', [i]));
|
|
end;
|
|
end;
|
|
|
|
function XmlTextReader.MoveToAttribute(name: string):Boolean;
|
|
begin
|
|
try
|
|
MoveToAttribute(FAttrNames.IndexOf(name));
|
|
Result := True;
|
|
except
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function XmlTextReader.GetDepth: integer;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function XmlTextReader.GetHasAttributes: Boolean;
|
|
begin
|
|
Result := FAttrNames.Count > 0;
|
|
end;
|
|
|
|
procedure DeleteInvisibleSymbol(var s: string);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := Length(s) downto 1 do
|
|
if not ((s[i] in ['a'..'z']) or (s[i] <> '.') or (s[i] <> ':')) then
|
|
Delete(s, i, 1);
|
|
end;
|
|
|
|
function CompareLexem(const s, Substr: string; Index: Integer):Boolean;
|
|
var
|
|
tmp: string;
|
|
Len: Integer;
|
|
begin
|
|
Len := Length(Substr);
|
|
tmp := Copy(s, Index, Len);
|
|
Result := CompareText(tmp, Substr) = 0;
|
|
end;
|
|
|
|
procedure XmlTextReader.InitInstance;
|
|
begin
|
|
if FTextLen > 0 then
|
|
FEof := False
|
|
else
|
|
FEof := True;
|
|
FState := Initial;
|
|
FNodeType := ntNone;
|
|
FOffset := 1;
|
|
FAttrNames := TStringList.Create;
|
|
FAttrPrefix := TStringList.Create;
|
|
FAttrValues := TStringList.Create;
|
|
FCurrElementName := '';
|
|
end;
|
|
|
|
function XmlTextReader.GetEof: Boolean;
|
|
begin
|
|
if Assigned(FReader) then
|
|
Result := FReader.Eof
|
|
else begin
|
|
Result := FOffset >= FTextLen;
|
|
FEof := Result;
|
|
end;
|
|
end;
|
|
|
|
{ XmlTextWriter }
|
|
|
|
constructor XmlTextWriter.Create(w: StreamWriter);
|
|
begin
|
|
FFormatting := fmtNone;
|
|
FIndentation := 2;
|
|
FIndentChar := ' ';
|
|
FQuoteChar := '"';
|
|
FWriteState := wsStart;
|
|
FDepth := 0;
|
|
FPrefix := TStringList.Create;
|
|
FPosStack := TStack.Create;
|
|
FTagStack := TStringList.Create;
|
|
FWriter := w;
|
|
end;
|
|
|
|
destructor XmlTextWriter.Destroy;
|
|
begin
|
|
FPrefix.Free;
|
|
FPosStack.Free;
|
|
FTagStack.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure XmlTextWriter.InternalWriteStartElement(const Prefix, LocalName, ns: string);
|
|
var
|
|
EndTagPos: Integer;
|
|
begin
|
|
InternalCloseStartTag;
|
|
if FWriteState = wsContent then
|
|
FlushData;
|
|
|
|
if FDepth > 0 then
|
|
FText := FText + LineSeparator;
|
|
|
|
if Prefix <> '' then
|
|
FText := FText + IndentStr + '<' + Prefix + ':' + LocalName
|
|
else
|
|
FText := FText + IndentStr + '<' + LocalName;
|
|
|
|
if ns <> '' then
|
|
if Prefix <> '' then
|
|
FText := FText + ' ' + 'xmlns:' + Prefix + '=' + FQuoteChar + ns + FQuoteChar
|
|
else
|
|
FText := FText + ' ' + 'xmlns=' + FQuoteChar + ns + FQuoteChar;
|
|
|
|
EndTagPos := Length(FText);
|
|
|
|
inc(FDepth);
|
|
|
|
FPosStack.Push(Pointer(EndTagPos));
|
|
if Prefix <> '' then
|
|
PushTagName(Prefix + ':' + LocalName)
|
|
else
|
|
PushTagName(LocalName);
|
|
|
|
FWriteState := wsElement;
|
|
end;
|
|
|
|
procedure XmlTextWriter.InternalWriteElementString(const LocalName, ns, Value: string);
|
|
begin
|
|
InternalCloseStartTag;
|
|
if FWriteState = wsElement then
|
|
inc(FDepth);
|
|
FText := FText + LineSeparator;
|
|
FText := FText + IndentStr + '<' + LocalName;
|
|
|
|
if ns <> '' then
|
|
FText := FText + ' xmlns=' + FQuoteChar + ns + FQuoteChar + '>'
|
|
else
|
|
FText := FText + '>';
|
|
|
|
if Value <> '' then
|
|
FText := FText + Value;
|
|
FText := FText + '</' + LocalName + '>';
|
|
if FWriteState = wsElement then
|
|
dec(FDepth);
|
|
FlushData;
|
|
FWriteState := wsContent;
|
|
end;
|
|
|
|
procedure XmlTextWriter.InternalWriteAttributeString(const Prefix, LocalName, ns, Value: string);
|
|
var
|
|
AttrPos: Integer;
|
|
AttrStr: string;
|
|
begin
|
|
if FWriteState in [wsElement, wsAttribute] then
|
|
AttrPos := Integer(FPosStack.Pop) + 1
|
|
else
|
|
raise XmlException.Create('Token WriteAttributeString in state Content would result in an invalid XML document.');
|
|
|
|
if Prefix <> '' then
|
|
AttrStr := ' ' + Prefix + ':'
|
|
else
|
|
AttrStr := ' ';
|
|
AttrStr := AttrStr + LocalName + '=' + FQuoteChar + Value + FQuoteChar;// + ' ';
|
|
|
|
Insert(AttrStr, FText, AttrPos);
|
|
|
|
AttrPos := AttrPos + Length(AttrStr);
|
|
|
|
if ns <> '' then begin
|
|
AttrStr := 'xmlns:' + Prefix + '=' + FQuoteChar + ns + FQuoteChar;// + ' ';
|
|
Insert(AttrStr, FText, AttrPos);
|
|
AttrPos := AttrPos + Length(AttrStr);
|
|
end;
|
|
|
|
FPosStack.Push(Pointer(AttrPos-1));
|
|
FWriteState := wsAttribute;
|
|
end;
|
|
|
|
procedure XmlTextWriter.FlushData;
|
|
begin
|
|
FWriter.Write(FText);
|
|
FText := '';
|
|
end;
|
|
|
|
procedure XmlTextWriter.Close;
|
|
begin
|
|
FlushData;
|
|
end;
|
|
|
|
procedure XmlTextWriter.WriteStartElement(const LocalName: string);
|
|
begin
|
|
InternalWriteStartElement('', LocalName, '');
|
|
end;
|
|
|
|
procedure XmlTextWriter.WriteStartElement(const Prefix, LocalName, ns: string);
|
|
begin
|
|
if (Prefix <> '') and (ns = '') then
|
|
raise XmlException.Create('Cannot use a prefix with an empty namespace.');
|
|
|
|
InternalWriteStartElement(Prefix, LocalName, ns);
|
|
end;
|
|
|
|
procedure XmlTextWriter.WriteStartElement(const LocalName, ns: string);
|
|
begin
|
|
InternalWriteStartElement('', LocalName, ns);
|
|
end;
|
|
|
|
procedure XmlTextWriter.WriteEndElement;
|
|
begin
|
|
dec(FDepth);
|
|
if (FWriteState = wsAttribute) then begin
|
|
FText := FText + ' />';
|
|
PopTagName;
|
|
FWriteState := wsContent;
|
|
end
|
|
else
|
|
InternalWriteEndElement;
|
|
FlushData;
|
|
end;
|
|
|
|
procedure XmlTextWriter.InternalWriteEndElement;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
InternalCloseStartTag;
|
|
Len := Length(FText);
|
|
if (FText = '') or ((Len >= 2) and (FText[Len] <> #10) and (FText[Len-1] <> #13)) then
|
|
FText := FText + LineSeparator + IndentStr + '</' + PopTagName + '>'
|
|
else
|
|
FText := FText + '</' + PopTagName + '>';
|
|
FWriteState := wsContent;
|
|
end;
|
|
|
|
procedure XmlTextWriter.WriteFullEndElement;
|
|
begin
|
|
dec(FDepth);
|
|
InternalWriteEndElement;
|
|
FlushData;
|
|
end;
|
|
|
|
procedure XmlTextWriter.WriteString(const Text: string);
|
|
begin
|
|
InternalCloseStartTag;
|
|
FText := FText + Text;
|
|
FWriteState := wsContent;
|
|
end;
|
|
|
|
procedure XmlTextWriter.WriteElementString(const LocalName, ns, value: string);
|
|
begin
|
|
InternalWriteElementString(LocalName, ns, Value);
|
|
end;
|
|
|
|
procedure XmlTextWriter.WriteElementString(const LocalName, Value: string);
|
|
begin
|
|
InternalWriteElementString(LocalName, '', Value);
|
|
end;
|
|
|
|
procedure XmlTextWriter.WriteAttributeString(const LocalName, Value: string);
|
|
begin
|
|
InternalWriteAttributeString('', LocalName, '', Value);
|
|
end;
|
|
|
|
procedure XmlTextWriter.WriteAttributeString(const Prefix, LocalName, ns, Value: string);
|
|
begin
|
|
if (Prefix <> '') and (ns = '') then
|
|
raise XmlException.Create('Cannot use a prefix with an empty namespace.');
|
|
|
|
InternalWriteAttributeString(Prefix, LocalName, ns, Value);
|
|
end;
|
|
|
|
function XmlTextWriter.IndentStr: string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
if (FFormatting = fmtIndented) and (FDepth <> 0) then
|
|
for i := 1 to FDepth * FIndentation do
|
|
Result := Result + FIndentChar;
|
|
end;
|
|
|
|
function XmlTextWriter.PopTagName: string;
|
|
begin
|
|
if FTagStack.Count = 0 then
|
|
raise XmlException.Create('There was no XML start tag open.');
|
|
Result := FTagStack[FTagStack.Count-1];
|
|
FTagStack.Delete(FTagStack.Count-1);
|
|
end;
|
|
|
|
procedure XmlTextWriter.PushTagName(const TagName: string);
|
|
begin
|
|
FTagStack.Add(TagName);
|
|
end;
|
|
|
|
procedure XmlTextWriter.InternalCloseStartTag;
|
|
begin
|
|
if FWriteState in [wsElement, wsAttribute] then begin
|
|
FPosStack.Pop;
|
|
FText := TrimRight(FText);
|
|
FText := FText + '>';
|
|
end;
|
|
end;
|
|
|
|
{ StreamWriter }
|
|
|
|
constructor StreamWriter.Create(const path: string; Append: Boolean);
|
|
begin
|
|
inherited Create;
|
|
|
|
if FileExists(path) and Append then begin
|
|
FWriter := TFileStream.Create(path, fmOpenReadWrite);
|
|
FWriter.Seek(0, soFromEnd);
|
|
end
|
|
else
|
|
FWriter := TFileStream.Create(path, fmCreate);
|
|
FReleaseWriter := True;
|
|
end;
|
|
|
|
constructor StreamWriter.Create(output: TStream; Encoding: EncodingClass);
|
|
begin
|
|
inherited Create;
|
|
|
|
FWriter := output;
|
|
FReleaseWriter := False;
|
|
FEncodingClass := Encoding;
|
|
end;
|
|
|
|
destructor StreamWriter.Destroy;
|
|
begin
|
|
if FReleaseWriter then
|
|
FWriter.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure StreamWriter.Close;
|
|
begin
|
|
end;
|
|
|
|
procedure StreamWriter.Flush;
|
|
begin
|
|
end;
|
|
|
|
procedure StreamWriter.Write(value: string);
|
|
var
|
|
Str: string;
|
|
begin
|
|
if FEncodingClass <> nil then begin
|
|
Str := FEncodingClass.GetString(TBytes(value));
|
|
FWriter.Write(PChar(Str)^, Length(Str));
|
|
end
|
|
else
|
|
FWriter.Write(PChar(value)^, Length(value));
|
|
end;
|
|
|
|
procedure StreamWriter.WriteLine(const value: string);
|
|
begin
|
|
Write(value + LineSeparator);
|
|
end;
|
|
|
|
{ StreamReader }
|
|
|
|
constructor StreamReader.Create(const path: string; detectEncodingFromByteOrderMarks: Boolean);
|
|
begin
|
|
FCapacity := 512;
|
|
FReader := TFileStream.Create(path, fmOpenRead);
|
|
FReleaseReader := True;
|
|
end;
|
|
|
|
constructor StreamReader.Create(input: TStream);
|
|
begin
|
|
FCapacity := 512;
|
|
FReader := input;
|
|
FReleaseReader := False;
|
|
end;
|
|
|
|
destructor StreamReader.Destroy;
|
|
begin
|
|
if FReleaseReader then
|
|
FReader.Free;
|
|
end;
|
|
|
|
function StreamReader.Eof: Boolean;
|
|
begin
|
|
Result := FReader.Position = FReader.Size;
|
|
end;
|
|
|
|
procedure StreamReader.Close;
|
|
begin
|
|
|
|
end;
|
|
|
|
function StreamReader.ReadToEnd:string;
|
|
var
|
|
Len: Int64;
|
|
begin
|
|
Len := FReader.Size - FReader.Position;
|
|
SetLength(Result, Len);
|
|
Read(TChars(Result), 0, Len);
|
|
end;
|
|
|
|
function StreamReader.Read(buffer: TChars; Index, Count: Integer):Integer;
|
|
begin
|
|
Result := FReader.Read((PChar(buffer) + Index)^, Count);
|
|
end;
|
|
|
|
function StreamReader.ReadLine:string;
|
|
var
|
|
SeparatorPos: Integer;
|
|
Count, BeginPos: Integer;
|
|
Position, NextPosition: Int64;
|
|
begin
|
|
if Eof then begin
|
|
Result := '';
|
|
exit;
|
|
end;
|
|
|
|
SetLength(Result, FCapacity);
|
|
System.FillChar(Result[1], Length(Result), ' ');
|
|
Position := FReader.Position;
|
|
|
|
Count := 1;
|
|
SeparatorPos := -1;
|
|
BeginPos := 1;
|
|
while True do begin
|
|
Count := FReader.Read(Result[BeginPos], Length(Result) - BeginPos + 1);
|
|
SeparatorPos := PosEx(LineSeparator, Result, BeginPos-1);
|
|
|
|
if Eof or (SeparatorPos <> 0) then
|
|
break;
|
|
BeginPos := Length(Result)+1;
|
|
SetLength(Result, BeginPos + Round(BeginPos * 0.3));
|
|
System.FillChar(Result[BeginPos], Length(Result) - BeginPos + 1, ' ');
|
|
end;
|
|
|
|
if SeparatorPos <> 0 then
|
|
SetLength(Result, SeparatorPos + 1)
|
|
else
|
|
SetLength(Result, Count);
|
|
|
|
FCapacity := Length(Result);
|
|
NextPosition := Position + FCapacity;
|
|
if (Count <> 0) and (NextPosition + 1 <> FReader.Size) then
|
|
FReader.Seek(Position - FReader.Position + FCapacity, soFromCurrent);
|
|
end;
|
|
|
|
{ TXmlParser }
|
|
|
|
constructor TXmlParser.Create(const Text: string);
|
|
begin
|
|
inherited;
|
|
|
|
FSymbolLexems := XmlSymbolLexems;
|
|
FKeywordLexems := XmlKeywordLexems;
|
|
end;
|
|
|
|
{ StringReader }
|
|
|
|
constructor StringReader.Create(Text: string);
|
|
begin
|
|
FText := Text;
|
|
end;
|
|
|
|
initialization
|
|
XmlSymbolLexems := TStringList.Create;
|
|
XmlKeywordLexems := TStringList.Create;
|
|
|
|
XmlSymbolLexems.AddObject(':', TObject(integer(16)));
|
|
XmlSymbolLexems.AddObject('=', TObject(integer(19)));
|
|
XmlSymbolLexems.CustomSort(CRCmpStrings);
|
|
|
|
finalization
|
|
XmlSymbolLexems.Free;
|
|
XmlKeywordLexems.Free;
|
|
|
|
end.
|