unit XMLWriter;

interface

uses
  Classes, SysUtils;

type

  TXmlStandalone = (xsOmit, xsYes, xsNo);

  TXmlCloseTag = (xtNone, xtClose, xtSlashClose);

  TXMLWriter = class
  private
    FCapacity: LongInt;
    FLength: Integer;
    FBuffer: PChar;
    procedure Grow;
  public
    constructor Create(const Standalone: TXmlStandalone);
    destructor Destroy; override;
    procedure WriteValue(const Buffer: PChar);
    procedure OpenElement(const Name: PChar; const CloseTag: TXmlCloseTag);
    procedure WriteElement(const Name, Value: PChar);
    procedure WriteAttribute(const Name, Value: PChar; const CloseTag: TXmlCloseTag); overload;
    procedure WriteBuffer(const Buffer: PChar);
    procedure WriteChar(const Value: Char);
    procedure CloseElement(const Name: PChar);
  end; 

implementation

const

  cOpenTag       = '<';
  cCloseTag      = '>';
  cSlash         = '/';
  cOpenSlashTag  = '</';
  cSlashCloseTag = '/>';
  cSpace         = ' ';
  cEquality      = '=';
  cApostrophe    = '"';
  cEqualApos     = '="';
  cXml           = '<?xml version="1.0" encoding="UTF-8" standalone="%s" ?>';
  cStandalones   : array [TXmlStandalone] of string = ('omit', 'yes', 'no');

{ TXMLWriter }

constructor TXMLWriter.Create(const Standalone: TXmlStandalone);
begin
  FCapacity := 0;
  FLength := 0;

  Grow;
  // xml declarations
  WriteBuffer(PChar(Format(cXml, [cStandalones[Standalone]])));
end;

destructor TXMLWriter.Destroy;
begin
  if FCapacity > 0 then
    FreeMem(FBuffer);
  FBuffer := nil;
  inherited Destroy;
end;

procedure TXMLWriter.Grow;
var
  NewCapacity: Integer;
begin
  NewCapacity := FCapacity + $200;
  if FCapacity = 0 then
  begin
    GetMem(FBuffer, NewCapacity * SizeOf(Char))
  end
  else
  begin
    ReallocMem(FBuffer, NewCapacity * SizeOf(Char));
  end;
  FCapacity := NewCapacity;
end;

procedure TXMLWriter.OpenElement(const Name: PChar; const CloseTag: TXmlCloseTag);
begin
  // <
  WriteChar(cOpenTag);
  // name
  WriteBuffer(Name);
  // >
  case CloseTag of
    xtClose: WriteChar(cCloseTag);
    xtSlashClose: WriteBuffer(cSlashCloseTag);
  end;
end;

procedure TXMLWriter.CloseElement(const Name: PChar);
begin
  // </
  WriteBuffer(cOpenSlashTag);
  // name
  WriteBuffer(Name);
  // >
  WriteChar(cCloseTag);
end;


procedure TXMLWriter.WriteElement(const Name, Value: PChar);
begin
  OpenElement(Name, xtClose);
  if Value <> nil then
  begin
    // value
    WriteValue(Value);
    // </name>
    CloseElement(Name);
  end
  else
    // />
    WriteBuffer(cSlashCloseTag);
end;


procedure TXMLWriter.WriteAttribute(const Name, Value: PChar; const CloseTag: TXmlCloseTag);
begin
  // space
  WriteChar(cSpace);
  // name
  WriteBuffer(Name);
  // ="
  WriteBuffer(cEqualApos);
  // value
  WriteValue(Value);
  // "
  WriteChar(cApostrophe);
  // >
  case CloseTag of
    xtClose: WriteChar(cCloseTag);
    xtSlashClose: WriteBuffer(cSlashCloseTag);
  end;
end;


procedure TXMLWriter.WriteBuffer(const Buffer: PChar);
var
  P: PChar;
begin
  P := Buffer;  
  while P^ <> #0 do begin
    (FBuffer + FLength)^ := P^;
    Inc(FLength);
    if FLength >= FCapacity then
      Grow;
    Inc(P);
  end;
end;

procedure TXMLWriter.WriteChar(const Value: Char);
begin
  (FBuffer + FLength)^ := Value;
  Inc(FLength);
  if FLength >= FCapacity then
    Grow;
end;


procedure TXMLWriter.WriteValue(const Buffer: PChar);
const
   clt  = '%lt;';
   cgt  = '%gt;';
   cmp  = '&amp;';
   cqt  = '&quot;';
var
  P: PChar;
  n : Integer;
begin
  P := Buffer;
  while P^ <> #0 do
  begin
    case P^ of
      '<':
        begin
          WriteBuffer(clt);
          Inc(P);
        end;
      '>':
        begin
          WriteBuffer(cgt);
          Inc(P);
        end;
      '&':
        begin
          WriteBuffer(cmp);
          Inc(P);
        end;
      '"':
        begin
          WriteBuffer(cqt);
          Inc(P);
        end
    else
      begin
         (FBuffer + FLength)^ := P^;
         Inc(FLength);
         if FLength = FCapacity then
           Grow;
         Inc(P);
      end;
    end
  end;
end;

end.