type
TXMLStreamWriter =
class
private
/// <summary>
/// end the current string/TAG with a new line
/// </summary>
FNewLineWritten: Boolean;
FIsStartTagClosed: Boolean;
FStream: TStringStream;
FTagStack: TStringStack;
/// <summary>
/// original comment : not entirely correct implementation as some names
/// are correct <br />but it still returns False, but that occurs only
/// with names using <br />characters outside the american alphabet
/// </summary>
function IsValidTagName(
const ATagName: WideString): Boolean;
/// <summary>
/// a too simple check for invalid characters, more or less correct for
/// ANSI names.
/// </summary>
/// <remarks>
/// [#0..#$40,#$5B..#$60,#$7B..#$FF]; <br />InvalidOtherChar =
/// [#0..#$2C,#$5B..#$60,#$7B..#$B6,#$B8..#$FF]; <br />
/// ValidNameOtherChar:WideString =
/// ['a'..'z','A'..'Z','_',':','0'..'9','.','-'];
/// </remarks>
function IsValidAttributeName(
const AAttributeName: WideString): Boolean;
procedure Indent;
function IsTagStarted: Boolean;
function LastTag:
String;
function MakeValidAttributeValue(
const AValue:
String):
String;
procedure AssertLastTagClosed;
public
constructor Create;
destructor Destroy;
override;
procedure AddRaw(
const Data:
String);
procedure AddNewLine;
procedure SetAttribute(
const Attribute, Value:
String);
function ToString:
String;
procedure StartTag(
const Tag:
String);
procedure StopTag;
procedure SavetoFile(Filename :
string);
end;
type
TGRAPHMLStreamWriter =
class(TXMLStreamWriter)
procedure AddHeader;
procedure AddFooter;
end;
implementation
{ TXMLStreamWriter }
function TXMLStreamWriter.IsValidTagName(
const ATagName: WideString): Boolean;
begin
Result := IsValidAttributeName(ATagName);
end;
procedure TXMLStreamWriter.SavetoFile(Filename:
string);
begin
FStream.SaveToFile(Filename);
end;
procedure TXMLStreamWriter.AddRaw(
const Data:
String);
var
StrLen: integer;
begin
// Stream.WriteBuffer(Pointer(Str)^, StrLen * SizeOf(Char)); //All Delphi versions compatible
StrLen := length(Data);
self.FStream.WriteBuffer(Pointer(Data)^, StrLen * SizeOf(Char))
end;
constructor TXMLStreamWriter.Create;
begin
FTagStack := TStringStack.Create;
FStream := TStringStream.Create('
', TEncoding.UTF8);
FIsStartTagClosed := True;
end;
destructor TXMLStreamWriter.Destroy;
begin
FTagStack.Free;
FStream.Free;
inherited;
end;
function TXMLStreamWriter.ToString:
String;
begin
Result := self.FStream.DataString;
end;
{ TGRAPHMLStreamWriter }
procedure TGRAPHMLStreamWriter.AddFooter;
begin
self.AddRaw('
</graphml>');
end;
procedure TGRAPHMLStreamWriter.AddHeader;
begin
self.AddRaw('
<?xml version="1.0" encoding="UTF-8"?> ');
self.AddRaw('
<graphml xmlns="http://graphml.graphdrawing.org/xmlns" ');
self.AddRaw('
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" ');
self.AddRaw('
xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns ');
self.AddRaw('
http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd"> ');
AddNewLine;
end;