unit QXMLWriter;

{$I QExport4VerCtrl.inc}

interface

uses
  {$IFDEF VCL16}
    System.Classes,
    System.Contnrs,
  {$ELSE}
    Classes,
    Contnrs,
  {$ENDIF}
  QExport4, QExport4Common, QExport4Types;

type
  TNodeStack = class (TObject)
  private
    FNodeList: TqeStringList;
    FEmptyElementTag: Boolean;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Push(AItem: qeString);
    function Pop: qeString;
    function Peek: qeString;
    property Count: Integer read GetCount;
    property EmptyElementTag : Boolean read FEmptyElementTag
      write FEmptyElementTag;
  end;

  TQXMLWriter = class
  private
    FNodeStack: TNodeStack;
    FStream: TStream;
  public
    constructor Create(AStream: TStream); virtual;
    destructor Destroy; override;
{$IFDEF VCL12}
    procedure Write(const WS: AnsiString);
    procedure WriteLn(const WS: AnsiString);
    function GetStr( GetStrValue : WideString): AnsiString;
{$ELSE}
    function GetStr( GetStrValue : WideString): WideString;
    procedure Write(const WS: WideString);
    procedure WriteLn(const WS: WideString);
{$ENDIF}
    procedure CreateProcessingInstruction(Version, Encoding,
      Standalone: WideString);
    procedure BeginNode(const Name, Text: WideString;
      const AttNames, AttValues: array of WideString); overload;
    procedure EndNode(Name: WideString; EndLine: Boolean = True); overload;
    procedure CreateFullNode(const Name, Text: WideString;
      const AttNames, AttValues: array of WideString); overload;
    // dee new
    procedure BeginNode(const Name: WideString); overload;
    procedure BeginNode(const Name: WideString; const AttNames,
      AttValues: array of WideString); overload;
    procedure AddAttr(const Name, Value: WideString);
    procedure EndNode(EndLine: Boolean = True); overload;
    procedure CreateFullNode(const Name: WideString; const AttNames,
      AttValues: array of WideString; const Text: WideString); overload;
    procedure CreateFullNode(const Name: WideString; const AttNames,
      AttValues: array of WideString); overload;
    procedure CreateFullNode(const Name: WideString; const Text: WideString = ''); overload;
    property Stream: TStream read FStream write FStream;
    property NodeStack: TNodeStack read FNodeStack;
    //\dee
  end;

implementation

uses
  {$IFDEF VCL16}
    System.SysUtils;
  {$ELSE}
    SysUtils;
  {$ENDIF}

{ TXMLWriter }

procedure TQXMLWriter.CreateProcessingInstruction(Version, Encoding,
  Standalone: WideString);
var
  Body: WideString;
begin
  Body := '';
  if Version <> '' then
    Body := Body + Format('version="%s" ', [Version]);
  if Encoding <> '' then
    Body := Body + Format('encoding="%s" ', [Encoding]);
  if Standalone <> '' then
    Body := Body + Format('standalone="%s" ', [Standalone]);
  WriteLn('<?xml ' + GetStr(Body) + '?>');
end;

{$IFDEF VCL12}
function TQXMLWriter.GetStr( GetStrValue : WideString): AnsiString;
begin
  Result := UTF8Encode( GetStrValue);
end;
{$ELSE}
function TQXMLWriter.GetStr( GetStrValue : WideString): WideString;
begin
  Result := GetStrValue;
end;
{$ENDIF}

procedure TQXMLWriter.BeginNode(const Name: WideString);
begin
  if (FNodeStack.Count > 0) and FNodeStack.EmptyElementTag then
    Write('>');
//  WriteLn(''); // dee for test
  Write('<' + GetStr(Name));
  FNodeStack.Push(Name);
end;

procedure TQXMLWriter.AddAttr(const Name, Value: WideString);
begin
  Write( ' ' + GetStr(Name) + '="' + GetStr(Value) + '"');
end;

procedure TQXMLWriter.EndNode(EndLine: Boolean);// = True);
var
  Name: WideString;
  empty: Boolean;
begin
  empty := FNodeStack.EmptyElementTag;
  Name := FNodeStack.Pop();
  if empty then
  begin
    if EndLine then
      WriteLn('/>')
    else
      Write('/>');
  end
  else
  begin
    if EndLine then
      WriteLn('</' + GetStr(Name) + '>')
    else
      Write('</' + GetStr(Name) + '>');
  end;
end;

procedure TQXMLWriter.BeginNode(const Name: WideString; const AttNames,
  AttValues: array of WideString);
var
  i: Integer;
begin
  Assert(Length(AttNames)=Length(AttValues),'The number of attributes is not equal to the number of values. NodeName = "'+Name+'"');
  BeginNode(Name);
  for i:=0 to Length(AttNames)-1 do
    AddAttr(AttNames[i],AttValues[i]);
end;

procedure TQXMLWriter.CreateFullNode(const Name: WideString;
  const AttNames, AttValues: array of WideString; const Text: WideString);
begin
  BeginNode(Name, AttNames, AttValues);
  if Text <> '' then
  begin
    FNodeStack.EmptyElementTag := False;
    Write('>' + GetStr(Text));
  end;
  EndNode();
end;

procedure TQXMLWriter.CreateFullNode(const Name: WideString;
  const AttNames, AttValues: array of WideString);
begin
  BeginNode(Name, AttNames, AttValues);
  EndNode();
end;

procedure TQXMLWriter.CreateFullNode(const Name: WideString;
  const Text: WideString = '');
begin
  CreateFullNode(Name,[],[],Text);
end;

//
// old version BEGIN *************************************************
//

procedure TQXMLWriter.BeginNode(const Name, Text: WideString; const AttNames,
  AttValues: array of WideString);
var
  i: Integer;
begin
//  WriteLn(''); // dee for test
  Write('<' + GetStr(Name));
  if Length(AttNames) > 0 then Write(' ');
  for i := 0 to Length(AttNames) - 1 do
    Write( GetStr(AttNames[i]) + '="' + GetStr(AttValues[i]) + '" ');
  Write('>' + GetStr(Text));
end;

procedure TQXMLWriter.EndNode(Name: WideString; EndLine: Boolean);
begin
  if EndLine then
    WriteLn('</' + GetStr(Name) + '>')
  else
    Write('</' + GetStr(Name) + '>');
end;

procedure TQXMLWriter.CreateFullNode(const Name, Text: WideString;
  const AttNames, AttValues: array of WideString);
var
  i: Integer;
begin
//  WriteLn(''); // dee for test
  Write('<' + GetStr(Name));
  if Length(AttNames) > 0 then Write(' ');
  for i := 0 to Length(AttNames) - 1 do
    Write(GetStr(AttNames[i]) + '="' + GetStr(AttValues[i]) + '" ');
  if Text <> '' then
    Write('>' + GetStr(Text) + '</' + GetStr(Name) + '>')
  else
    Write('/>');
end;

//
// old version END *************************************************
//


{$IFDEF VCL12}
procedure TQXMLWriter.Write(const WS: AnsiString);
{$ELSE}
procedure TQXMLWriter.Write(const WS: WideString);
{$ENDIF}
var
  str: AnsiString;
begin
  {$IFDEF VCL12}
    str := AnsiString(WS);               
  {$ELSE}
    {$IFDEF VCL6}
      str := UTF8Encode(WS);
    {$ELSE}
      str := Utf8EncodeForDelphi5(WS);
    {$ENDIF}
  {$ENDIF}
  FStream.WriteBuffer(str[1], Length(str));
end;

{$IFDEF VCL12}
procedure TQXMLWriter.WriteLn(const WS: AnsiString);
begin
  Write(WS + AnsiString(CRLF));
end;
{$ELSE}
procedure TQXMLWriter.WriteLn(const WS: WideString);
begin
  Write(WS + CRLF);
end;
{$ENDIF}

constructor TQXMLWriter.Create(AStream: TStream);
begin
  inherited Create;
  FStream := AStream;
  FNodeStack := TNodeStack.Create();
end;

destructor TQXMLWriter.Destroy;
begin
  FNodeStack.Free;
  inherited Destroy;
end;


constructor TNodeStack.Create;
begin
  inherited Create;
  FNodeList := TqeStringList.Create;
  FEmptyElementTag := False;
end;

destructor TNodeStack.Destroy;
begin
  FNodeList.Free;
  inherited Destroy;
end;

function TNodeStack.Peek: qeString;
begin
  Result := FNodeList[FNodeList.Count-1];
end;

function TNodeStack.Pop: qeString;
begin
  Result := Peek;
  FNodeList.Delete(FNodeList.Count-1);
  FEmptyElementTag := False;
end;

procedure TNodeStack.Push(AItem: qeString);
begin
  FNodeList.Add(AItem);
  FEmptyElementTag := True;
end;

function TNodeStack.GetCount: Integer;
begin
  Result := FNodeList.Count;
end;

end.
