unit XMLRoutines;
{
[XMLRoutines] [6.0]
Delphi 2005
December 2005

LICENSE

The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
"http://www.mozilla.org/MPL/"

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is "[XMLRoutines.pas]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2005 Martin Holmes 
and the University of Victoria Computing and Media Centre. The code was 
co-developed for university and personal projects, and rights are shared
by Martin Holmes and the University of Victoria. All Rights Reserved.
}

{
Written by Martin Holmes, 1999 - 2005.

This unit houses simple routines used for reading and writing
XML-style elements and structures. Most of these date back several years,
and are mainly now used for convenience; fully-fledged XML library implementations
such as XDOM will be more appropriate in most cases. However, these functions
can be fast where they're safe to use.

Dependencies:

TntUnicodeControls (Troy Wolbrink)
}

interface

uses Classes, SysUtils, XMLGlobals, TntClasses, Dialogs, TntSysUtils, WideStrUtils;

	function TagElement(strContent, strTag: string): string;
  function TagBoolean(Content: Boolean; strTag: string): string;
  function ReadElement(DeleteElement: Boolean; strTag: string; var strInput: string; var strResult: string): Boolean;
  function ReadElementEx(DeleteElement: Boolean; strTag: string; var strInput: string; var strResult: string): Boolean;
  function ReadBoolElement(DeleteElement: Boolean; strTag: string; var strInput: string; var boolResult: Boolean): Boolean;
  function EscapeStuff(InString: string): string;
  function UnescapeStuff(InString: string): string;
  function ReplaceStuff(Token, Replacement, InString: string): string;
  function StrToBool(InString: string): Boolean;
  function BoolToStr(InBool: Boolean): string;
  function SplitPath(InPath: string; var OutList: TStringList): Boolean;
  function GetSection(SectionPath, XMLSource: string; var StartPoint: integer; var Contents: string; var MissingContainers: TStringList): Boolean;
  function GetTag(Tag, XMLSource: string; var Contents: string; var StartPoint: integer; IncludeTags: Boolean): Boolean;
  function WriteXMLString(TagPath, StringToWrite: string; var XMLSource: string): Boolean;
  function WriteXMLBoolean(TagPath: string; BoolToWrite: Boolean; var XMLSource: string): Boolean;
  function WriteXMLInteger(TagPath: string; IntToWrite: integer; var XMLSource: string): Boolean;
  function ReadXMLString(XMLSource, TagPath, DefaultReturn: string): string;
  function ReadXMLBoolean(XMLSource, TagPath: string; DefaultReturn: Boolean): Boolean;
  function ReadXMLInteger(XMLSource, TagPath: string; DefaultReturn: integer): integer;
  function ReadXMLReal(XMLSource, TagPath: string; DefaultReturn: real): real;
  function SaveXMLFile(FilePath, XMLData: string): Boolean;
  function StripTags(InString: string): string; //Strips all tags out of a piece of text

//WideString versions
  function WTagElement(strContent, strTag: WideString): WideString;
  function WTagBoolean(Content: Boolean; strTag: WideString): WideString;
  function WReadElement(DeleteElement: Boolean; strTag: WideString; var strInput: WideString; var strResult: WideString): Boolean;
  function WReadElementEx(DeleteElement: Boolean; strTag: WideString; var strInput: WideString; var strResult: WideString): Boolean;
  function WReadBoolElement(DeleteElement: Boolean; strTag: WideString; var strInput: WideString; var boolResult: Boolean): Boolean;
  function WEscapeStuff(InString: WideString): WideString;
  function WUnescapeStuff(InString: WideString): WideString;
  function WStrToBool(InString: WideString): Boolean;
  function WBoolToStr(InBool: Boolean): WideString;
  function WSplitPath(InPath: WideString; var OutList: TTntStringList): Boolean;
  function WGetSection(SectionPath, XMLSource: WideString; var StartPoint: integer; var Contents: WideString; var MissingContainers: TTntStringList): Boolean;
  function WGetTag(Tag, XMLSource: WideString; var Contents: WideString; var StartPoint: integer; IncludeTags: Boolean): Boolean;
  function WWriteXMLString(TagPath, StringToWrite: WideString; var XMLSource: WideString): Boolean;
  function WWriteXMLBoolean(TagPath: WideString; BoolToWrite: Boolean; var XMLSource: WideString): Boolean;
  function WWriteXMLInteger(TagPath: WideString; IntToWrite: integer; var XMLSource: WideString): Boolean;
  function WReadXMLString(XMLSource, TagPath, DefaultReturn: WideString): WideString;
  function WReadXMLBoolean(XMLSource, TagPath: WideString; DefaultReturn: Boolean): Boolean;
  function WReadXMLInteger(XMLSource, TagPath: WideString; DefaultReturn: integer): integer;
  function WReadXMLReal(XMLSource, TagPath: WideString; DefaultReturn: real): real;
  function WSaveXMLFile(FilePath: string; XMLData: WideString): Boolean;
  function WStripTags(InString: WideString): WideString; //Strips all tags out of a piece of text
implementation


function TagElement(strContent, strTag: string): string;
//Adds tags to the content to create a tagged string;
//Returns the tagged string.
begin
	Result := '<' + strTag + '>' + strContent + '</' + strTag + '>';
end;

function TagBoolean(Content: Boolean; strTag: string): string;
//Converts boolean to a 1 or 0 representation, then
//adds tags to create a tagged string;
//Returns the tagged string.
var
strContent: string;

begin
	strContent := BoolToStr(Content);
	Result := '<' + strTag + '>' + strContent + '</' + strTag + '>';
end;

function ReadElement(DeleteElement: Boolean; strTag: string; var strInput: string; var strResult: string): Boolean;
//Attempts to read the first instance of an element given the tag.
//Returns true if there is a well-formed tagged element to read.
//If DeleteElement is true, deletes the tagged element from the input.
//Returns false if no well-formed tag can be found.
var
OpenTag: string;
CloseTag: string;
OpenPos: integer;
ClosePos: integer;
ElementStart: integer;
TagEnd: integer;
TempString: string;
begin
	try
//Set the result to false
		Result := False;

//Create the open tag
		OpenTag := '<' + strTag + '>';

//Find the first instance of it
		OpenPos := Pos(OpenTag, strInput);

//If none, bail
		if OpenPos < 1 then
  		Exit;

//Create the close tag
		CloseTag := '</' + strTag + '>';

//Create a copy of the input string starting from the open tag
		ElementStart := OpenPos + Length(OpenTag);
  	TempString := Copy(strInput, ElementStart, Length(strInput) - (ElementStart - 1));

//Find the first instance of the close tag
		ClosePos := Pos(CloseTag, TempString);

//If none, bail
		if ClosePos < 1 then
  		Exit;

//Extract the text from between the tags
		strResult := Copy(TempString, 1, (ClosePos - 1));

//If element is to be deleted, delete it
		if DeleteElement then
     	begin
//Work out the end position of the whole tag
				TagEnd := ElementStart + ClosePos + Length(CloseTag) - 1;
//Delete the tag
        	strInput := Copy(strInput, 1, OpenPos - 1) + Copy(strInput, TagEnd, Length(strInput) - (TagEnd - 1));
        end;

//Set result to true
		Result := True;
	except
  	Result := False;
  end;
end;

function ReadElementEx(DeleteElement: Boolean; strTag: string; var strInput: string; var strResult: string): Boolean;
//Same as above function, but handles the case where there are attributes inside
//the tag.
var
i: integer;
OpenTag: string;
CloseTag: string;
OpenPos: integer;
ClosePos: integer;
ElementStart: integer;
TagEnd: integer;
TempString: string;

begin

//Set the result to false
  Result := False;
  strResult := '';
  if (Length(strInput) < 1) or (Length(strTag) < 1) then
     Exit;
//	try

//Create the open tag
		OpenTag := '<' + strTag + '>';

//Find the first instance of it
		OpenPos := Pos(OpenTag, strInput);

//If none, look for an attributed element
		if OpenPos < 1 then
     	begin
           OpenTag := '<' + strTag + ' ';
           OpenPos := Pos(OpenTag, strInput);
           if OpenPos < 1 then
  				Exit;
           i := OpenPos + Length(OpenTag);
           while (strInput[i-1] <> '>') and (i < Length(strInput)) do
           	begin
               	OpenTag := OpenTag + strInput[i];
                 inc(i);
              end;
        end;

//Create the close tag
		CloseTag := '</' + strTag + '>';

//Create a copy of the input string starting from the open tag
		ElementStart := OpenPos + Length(OpenTag);
  	TempString := Copy(strInput, ElementStart, Length(strInput) - (ElementStart - 1));

//Find the first instance of the close tag
		ClosePos := Pos(CloseTag, TempString);

//If none, bail
		if ClosePos < 1 then
  		Exit;

//Extract the text from between the tags
		strResult := Copy(TempString, 1, (ClosePos - 1));

//If element is to be deleted, delete it
		if DeleteElement then
     	begin
//Work out the end position of the whole tag
				TagEnd := ElementStart + ClosePos + Length(CloseTag) - 1;
//Delete the tag
        	strInput := Copy(strInput, 1, OpenPos - 1) + Copy(strInput, TagEnd, Length(strInput) - (TagEnd - 1));
        end;

//Set result to true
		Result := True;
//	except
//  	Result := False;
//  end;
end;

function ReadBoolElement(DeleteElement: Boolean; strTag: string; var strInput: string; var boolResult: Boolean): Boolean;
//Attempts to read the first instance of a boolean element given the tag.
//Returns true if there is a well-formed tagged element to read.
//If DeleteElement is true, deletes the tagged element from the input.
//Returns false if no well-formed tag can be found.
//Functions by calling the generic ReadElement then converting the result.
var
OutBool: string;

begin
	if ReadElement(DeleteElement, strTag, strInput, OutBool) = True then
     begin
  		boolResult := StrToBool(OutBool);
        Result := True;
     end
  else
  	begin
     	boolResult := False;
        Result := False;
     end;
end;

function EscapeStuff(InString: string): string;
var
i: LongInt;
OutString: string;

begin
	OutString := '';
	if InString <> '' then
  	begin
			for i := 1 to Length(InString) do
        	begin
           	case InString[i] of
              	'&': OutString := OutString + '&amp;';
              	'<': OutString := OutString + '&lt;';
                 '>': OutString := OutString + '&gt;';
                 '''': OutString := OutString + '&apos;';
                 '"': OutString := OutString + '&quot;';
                 else OutString := OutString + InString[i];
              end;
           end;
     end;
  Result := OutString;
end;

function UnescapeStuff(InString: string): string;
begin
	InString := ReplaceStuff('&lt;', '<', InString);
  InString := ReplaceStuff('&gt;', '>', InString);
  InString := ReplaceStuff('&apos;', '''', InString);
  InString := ReplaceStuff('&quot;', '"', InString);
  Result := ReplaceStuff('&amp;', '&', InString);
end;

function ReplaceStuff(Token, Replacement, InString: string): string;

var
i: LongInt;
SoFar: LongInt;

begin
	if InString <> '' then
  	begin
			SoFar := 0;
			while Pos(Token, InString) > SoFar do
  			begin
     			i := Pos(Token, InString);
        		SoFar := (i-1) + Length(Replacement);
     			InString := Copy(InString, 0, i-1) + Replacement + Copy(InString, i+Length(Token), (Length(InString) - (i+Length(Token)-1)));
     		end;
     end;

     Result := InString;
end;

function StrToBool(InString: string): Boolean;
begin
	Result := (InString <> '0');
end;

function BoolToStr(InBool: Boolean): string;
begin
	if InBool = False then
  	Result := '0'
  else
  	Result := '1';
end;

function SplitPath(InPath: string; var OutList: TStringList): Boolean;
//Splits a back-slash-delimited path into its constituent elements
//so that they can be recursively processed.
var
TokenPosition: integer;
StartPoint: integer;
InString: string;

begin
Result := False;
	OutList.Clear;
  if Pos('\', InPath) < 1 then
  	begin
     	OutList.Add(InPath);
        Result := True;
        Exit;
     end;

  InString := InPath;

//Work through the string
	TokenPosition := Pos('\', InString);
	while TokenPosition > 0 do
  	begin

//Get the string
			OutList.Add(Copy(InString, 1, TokenPosition - 1));

//Remove it from InString
        StartPoint := TokenPosition + 1;
        InString := Copy(InString, StartPoint, Length(InString) - (StartPoint - 1));

     	TokenPosition := Pos('\', InString);
     end;

//Add the last bit
	OutList.Add(InString);
  Result := True;
end;

function GetSection(SectionPath, XMLSource: string; var StartPoint: integer; var Contents: string; var MissingContainers: TStringList): Boolean;
//Returns the contents of a section, along with its start and end points
//so that it can be amended and replaced in the overall string
var
PathList: TStringList;
SourceString: string;
TempStartPoint: integer;
FoundTag: Boolean;
TagContents: string;
i: integer;

begin
//Set defaults
	Result := False;
	StartPoint := 1;
	Contents := '';
	PathList := TStringList.Create;
  MissingContainers.Clear;
  try
  	if SplitPath(SectionPath, PathList) = False then
     	Exit;

     SourceString := XMLSource;

     for i := 0 to PathList.Count - 1 do
     	begin
				FoundTag := GetTag(PathList[i], SourceString, TagContents, TempStartPoint, False);
           if FoundTag = False then
           	MissingContainers.Add(PathList[i])
           else
           	StartPoint := StartPoint + TempStartPoint - 1;
           SourceString := TagContents;
        end;
     Contents := SourceString;
     Result := True;
  finally
  	PathList.Free;
  end;

end;

function GetTag(Tag, XMLSource: string; var Contents: string; var StartPoint: integer; IncludeTags: Boolean): Boolean;
//Gets the first instance of a particular tag in a source string.
//Returns true or false depending on whether the tag exists.
//The contents with or without the tags themselves is returned in Contents.
//Also returns the start point of the returned text, so it can be
//replaced later if necessary.

var
OpenTag: string;
CloseTag: string;
Beginning: integer;
Ending: integer;

begin
//Set defaults
	StartPoint := 0;
  Result := False;
  Contents := '';

//Set up the tags
	OpenTag := '<' + Tag + '>';
  CloseTag := '</' + Tag + '>';

//Find the start
	Beginning := Pos(OpenTag, XMLSource);
  if Beginning > 0 then
  	Result := True;

  if ((IncludeTags = False) and (Beginning > 0)) then
  	Beginning := Beginning + Length(OpenTag);

//Find the end
	Ending := Pos(CloseTag, XMLSource);
  if ((IncludeTags = True) and (Ending > 0)) then
  	Ending := Ending + Length(CloseTag);

  if ((Ending >= Beginning) and (Beginning > 0)) then
  	begin
     	Contents := Copy(XMLSource, Beginning, Ending - Beginning);
        StartPoint := Beginning;
     end;
end;

function WriteXMLString(TagPath, StringToWrite: string; var XMLSource: string): Boolean;
var
i: integer;
MissingTagList: TStringList;
CurrentTag: string;
StartPoint: integer;
FirstBit: string;
LastBit: string;

begin
	Result := False;
  try
     MissingTagList := TStringList.Create;
     try
     	if GetSection(TagPath, XMLSource, StartPoint, CurrentTag, MissingTagList) = True then
        	if CurrentTag <> StringToWrite then
           	begin
              	FirstBit := Copy(XMLSource, 1, StartPoint - 1);
                 LastBit := Copy(XMLSource, StartPoint + Length(CurrentTag), Length(XMLSource) - (StartPoint + Length(CurrentTag) - 1));
                 if MissingTagList.Count > 0 then
                 	for i := MissingTagList.Count - 1 downto 0 do
                    	StringToWrite := '<' + MissingTagList[i] + '>' + StringToWrite + '</' + MissingTagList[i] + '>';
              	XMLSource := FirstBit + StringToWrite + LastBit;
              end;
        Result := True;
     finally
        MissingTagList.Free;
     end;
  except
  	Result := False;
  end;

end;

function WriteXMLBoolean(TagPath: string; BoolToWrite: Boolean; var XMLSource: string): Boolean;
var
BoolString: string;

begin
	BoolString := BoolToStr(BoolToWrite);
  Result := WriteXMLString(TagPath, BoolString, XMLSource);
end;

function WriteXMLInteger(TagPath: string; IntToWrite: integer; var XMLSource: string): Boolean;
var
IntString: string;

begin
	IntString := IntToStr(IntToWrite);
  Result := WriteXMLString(TagPath, IntString, XMLSource);
end;

function ReadXMLString(XMLSource, TagPath, DefaultReturn: string): string;
var
PathList: TStringList;
SourceString: string;
StartPoint: integer; // needed only for compatibility
i: integer;
FoundTag: Boolean;
TagContents: string;

begin
//Set defaults
	Result := DefaultReturn;
	PathList := TStringList.Create;
  try
  	if SplitPath(TagPath, PathList) = False then
     	Exit;

     SourceString := XMLSource;
     FoundTag := False;

     for i := 0 to PathList.Count - 1 do
     	begin
     		FoundTag := GetTag(PathList[i], SourceString, TagContents, StartPoint, False);
           SourceString := TagContents;
        end;

     if FoundTag = True then
     	Result := SourceString;
  finally
  	PathList.Free;
  end;
end;

function ReadXMLBoolean(XMLSource, TagPath: string; DefaultReturn: Boolean): Boolean;
var
BoolString: string;
ResultString: string;

begin
  try
		BoolString := BoolToStr(DefaultReturn);
  	ResultString := ReadXMLString(XMLSource, TagPath, BoolString);
  	Result := StrToBool(Trim(ResultString));
  except
  	Result := DefaultReturn;
  end;
end;

function ReadXMLInteger(XMLSource, TagPath: string; DefaultReturn: integer): integer;
var
IntString: string;
ResultString: string;

begin
  try
		IntString := IntToStr(DefaultReturn);
  	ResultString := ReadXMLString(XMLSource, TagPath, IntString);
  	Result := StrToInt(Trim(ResultString));
  except
  	Result := DefaultReturn;
  end;
end;

function ReadXMLReal(XMLSource, TagPath: string; DefaultReturn: real): real;
var
RealString: string;
ResultString: string;

begin
  try
		RealString := FloatToStr(DefaultReturn);
  	ResultString := ReadXMLString(XMLSource, TagPath, RealString);
  	Result := StrToFloat(Trim(ResultString));
  except
  	Result := DefaultReturn;
  end;
end;

function SaveXMLFile(FilePath, XMLData: string): Boolean;
var
OutList: TStringList;
TokenPosition: integer;
StartPoint: integer;

begin
  if Pos('<?xml', XMLData) < 1 then
		XMLData := XMLHeader + #13#10#13#10 + XMLData;
	OutList := TStringList.Create;
  try
//Work through the string
     TokenPosition := Pos(#13#10, XMLData);
     while TokenPosition > 0 do
        begin

//Get the string
				OutList.Add(Copy(XMLData, 1, TokenPosition - 1));

//Remove it from InString
        	StartPoint := TokenPosition + 2;
        	XMLData := Copy(XMLData, StartPoint, Length(XMLData) - (StartPoint - 1));

     		TokenPosition := Pos(#13#10, XMLData);
     	end;

//Add the last bit
		if Length(XMLData) > 0 then
			OutList.Add(XMLData);

  	try
  		OutList.SaveToFile(FilePath);
  		Result := True;
  	except
  		Result := False;
  	end;
  finally
  	OutList.Free;
  end;
end;

function StripTags(InString: string): string;
var
i: integer;
InTag: Boolean;
OutString: string;

begin
	OutString := '';
  InTag := False;
	for i := 1 to Length(InString) do
  	begin
     	if InString[i] = '<' then
        	InTag := True;
        if InTag = False then
        	OutString := OutString + InString[i];
        if InString[i] = '>' then
        	InTag := False;
     end;
  StripTags := OutString;
end;

//WIDESTRING VERSIONS

function WTagElement(strContent, strTag: WideString): WideString;
begin
  Result := '<' + strTag + '>' + strContent + '</' + strTag + '>';
end;

function WTagBoolean(Content: Boolean; strTag: WideString): WideString;
//Converts boolean to a 1 or 0 representation, then
//adds tags to create a tagged string;
//Returns the tagged string.
var
strContent: WideString;

begin
	strContent := WideString(BoolToStr(Content));
	Result := '<' + strTag + '>' + strContent + '</' + strTag + '>';
end;

function WReadElement(DeleteElement: Boolean; strTag: WideString; var strInput: WideString; var strResult: WideString): Boolean;
//Attempts to read the first instance of an element given the tag.
//Returns true if there is a well-formed tagged element to read.
//If DeleteElement is true, deletes the tagged element from the input.
//Returns false if no well-formed tag can be found.
var
OpenTag: WideString;
CloseTag: WideString;
OpenPos: integer;
ClosePos: integer;
ElementStart: integer;
TagEnd: integer;
TempString: WideString;
begin
	try
//Set the result to false
		Result := False;

//Create the open tag
		OpenTag := '<' + strTag + '>';

//Find the first instance of it
		OpenPos := Pos(OpenTag, strInput);

//If none, bail
		if OpenPos < 1 then
  		Exit;

//Create the close tag
		CloseTag := '</' + strTag + '>';

//Create a copy of the input string starting from the open tag
		ElementStart := OpenPos + Length(OpenTag);
  	TempString := Copy(strInput, ElementStart, Length(strInput) - (ElementStart - 1));

//Find the first instance of the close tag
		ClosePos := Pos(CloseTag, TempString);

//If none, bail
		if ClosePos < 1 then
  		Exit;

//Extract the text from between the tags
		strResult := Copy(TempString, 1, (ClosePos - 1));

//If element is to be deleted, delete it
		if DeleteElement then
     	begin
//Work out the end position of the whole tag
				TagEnd := ElementStart + ClosePos + Length(CloseTag) - 1;
//Delete the tag
           TempString := Copy(strInput, 1, OpenPos - 1) + Copy(strInput, TagEnd, Length(strInput) - (TagEnd - 1));
           strInput := TempString;
//Couldn't use the previous method below -- it failed to perform the operation when the result
//would be an empty string (as in the last element of a set). Used the above system instead.
//        	strInput := Copy(strInput, 1, OpenPos - 1) + Copy(strInput, TagEnd, Length(strInput) - (TagEnd - 1));
//           ShowMessage(strInput);
        end;

//Set result to true
		Result := True;
	except
  	Result := False;
  end;
end;

function WReadElementEx(DeleteElement: Boolean; strTag: WideString; var strInput: WideString; var strResult: WideString): Boolean;
//Same as above function, but handles the case where there are attributes inside
//the tag.
var
i: integer;
OpenTag: string;
CloseTag: string;
OpenPos: integer;
ClosePos: integer;
ElementStart: integer;
TagEnd: integer;
TempString: string;
begin
	try
//Set the result to false
		Result := False;

//Create the open tag
		OpenTag := '<' + strTag + '>';

//Find the first instance of it
		OpenPos := Pos(OpenTag, strInput);

//If none, look for an attributed element
		if OpenPos < 1 then
     	begin
           OpenTag := '<' + strTag + ' ';
           OpenPos := Pos(OpenTag, strInput);
           if OpenPos < 1 then
  				Exit;
           i := OpenPos + Length(OpenTag);
           while (strInput[i-1] <> '>') and (i < Length(strInput)) do
           	begin
               	OpenTag := OpenTag + strInput[i];
                 inc(i);
              end;
        end;

//Create the close tag
		CloseTag := '</' + strTag + '>';

//Create a copy of the input string starting from the open tag
		ElementStart := OpenPos + Length(OpenTag);
  	TempString := Copy(strInput, ElementStart, Length(strInput) - (ElementStart - 1));

//Find the first instance of the close tag
		ClosePos := Pos(CloseTag, TempString);

//If none, bail
		if ClosePos < 1 then
  		Exit;

//Extract the text from between the tags
		strResult := Copy(TempString, 1, (ClosePos - 1));

//If element is to be deleted, delete it
		if DeleteElement then
     	begin
//Work out the end position of the whole tag
				TagEnd := ElementStart + ClosePos + Length(CloseTag) - 1;
//Delete the tag
        	strInput := Copy(strInput, 1, OpenPos - 1) + Copy(strInput, TagEnd, Length(strInput) - (TagEnd - 1));
        end;

//Set result to true
		Result := True;
	except
  	Result := False;
  end;
end;

function WReadBoolElement(DeleteElement: Boolean; strTag: WideString; var strInput: WideString; var boolResult: Boolean): Boolean;
//Attempts to read the first instance of a boolean element given the tag.
//Returns true if there is a well-formed tagged element to read.
//If DeleteElement is true, deletes the tagged element from the input.
//Returns false if no well-formed tag can be found.
//Functions by calling the generic ReadElement then converting the result.
var
OutBool: WideString;

begin
	if WReadElement(DeleteElement, strTag, strInput, OutBool) = True then
     begin
  		boolResult := WStrToBool(OutBool);
        Result := True;
     end
  else
  	begin
     	boolResult := False;
        Result := False;
     end;
end;

function WEscapeStuff(InString: WideString): WideString;
var
i: LongInt;
OutString: WideString;

begin
	OutString := '';
	if InString <> '' then
  	begin
			for i := 1 to Length(InString) do
        	begin
           	case InString[i] of
              	'&': OutString := OutString + '&amp;';
              	'<': OutString := OutString + '&lt;';
                 '>': OutString := OutString + '&gt;';
                 '''': OutString := OutString + '&apos;';
                 '"': OutString := OutString + '&quot;';
                 else OutString := OutString + InString[i];
              end;
           end;
     end;
  Result := OutString;
end;

function WUnescapeStuff(InString: WideString): WideString;
begin
	InString := WideStringReplace(InString, '&lt;', '<', [rfReplaceAll]);
  InString := WideStringReplace(InString, '&gt;', '>', [rfReplaceAll]);
  InString := WideStringReplace(InString, '&apos;', '''', [rfReplaceAll]);
  InString := WideStringReplace(InString, '&quot;', '"', [rfReplaceAll]);
  Result := WideStringReplace(InString, '&amp;', '&', [rfReplaceAll]);
end;

function WStrToBool(InString: WideString): Boolean;
begin
	Result := (InString <> '0');
end;

function WBoolToStr(InBool: Boolean): WideString;
begin
	if InBool = False then
  	Result := '0'
  else
  	Result := '1';
end;

function WSplitPath(InPath: WideString; var OutList: TTntStringList): Boolean;
//Splits a back-slash-delimited path into its constituent elements
//so that they can be recursively processed.
var
TokenPosition: integer;
StartPoint: integer;
InString: WideString;

begin
  Result := False;
	OutList.Clear;
  if Pos('\', InPath) < 1 then
  	begin
     	OutList.Add(InPath);
        Result := True;
        Exit;
     end;

  InString := InPath;

//Work through the string
	TokenPosition := Pos('\', InString);
	while TokenPosition > 0 do
  	begin

//Get the string
			OutList.Add(Copy(InString, 1, TokenPosition - 1));

//Remove it from InString
        StartPoint := TokenPosition + 1;
        InString := Copy(InString, StartPoint, Length(InString) - (StartPoint - 1));

     	TokenPosition := Pos('\', InString);
     end;

//Add the last bit
	OutList.Add(InString);
  Result := True;
end;

function WGetSection(SectionPath, XMLSource: WideString; var StartPoint: integer; var Contents: WideString; var MissingContainers: TTntStringList): Boolean;
//Returns the contents of a section, along with its start and end points
//so that it can be amended and replaced in the overall string
var
PathList: TTntStringList;
SourceString: WideString;
TempStartPoint: integer;
FoundTag: Boolean;
TagContents: WideString;
i: integer;

begin
//Set defaults
	Result := False;
	StartPoint := 1;
	Contents := '';
	PathList := TTntStringList.Create;
  MissingContainers.Clear;
  try
  	if WSplitPath(SectionPath, PathList) = False then
     	Exit;

     SourceString := XMLSource;

     for i := 0 to PathList.Count - 1 do
     	begin
				FoundTag := WGetTag(PathList[i], SourceString, TagContents, TempStartPoint, False);
           if FoundTag = False then
           	MissingContainers.Add(PathList[i])
           else
           	StartPoint := StartPoint + TempStartPoint - 1;
           SourceString := TagContents;
        end;
     Contents := SourceString;
     Result := True;
  finally
  	PathList.Free;
  end;

end;

function WGetTag(Tag, XMLSource: WideString; var Contents: WideString; var StartPoint: integer; IncludeTags: Boolean): Boolean;
//Gets the first instance of a particular tag in a source string.
//Returns true or false depending on whether the tag exists.
//The contents with or without the tags themselves is returned in Contents.
//Also returns the start point of the returned text, so it can be
//replaced later if necessary.

var
OpenTag: WideString;
CloseTag: WideString;
Beginning: integer;
Ending: integer;

begin
//Set defaults
	StartPoint := 0;
  Result := False;
  Contents := '';

//Set up the tags
	OpenTag := '<' + Tag + '>';
  CloseTag := '</' + Tag + '>';

//Find the start
	Beginning := Pos(OpenTag, XMLSource);
  if Beginning > 0 then
  	Result := True;

  if ((IncludeTags = False) and (Beginning > 0)) then
  	Beginning := Beginning + Length(OpenTag);

//Find the end
	Ending := Pos(CloseTag, XMLSource);
  if ((IncludeTags = True) and (Ending > 0)) then
  	Ending := Ending + Length(CloseTag);

  if ((Ending >= Beginning) and (Beginning > 0)) then
  	begin
     	Contents := Copy(XMLSource, Beginning, Ending - Beginning);
        StartPoint := Beginning;
     end;
end;

function WWriteXMLString(TagPath, StringToWrite: WideString; var XMLSource: WideString): Boolean;
var
i: integer;
MissingTagList: TTntStringList;
CurrentTag: WideString;
StartPoint: integer;
FirstBit: WideString;
LastBit: WideString;

begin
	Result := False;
  try
     MissingTagList := TTntStringList.Create;
     try
     	if WGetSection(TagPath, XMLSource, StartPoint, CurrentTag, MissingTagList) = True then
        	if CurrentTag <> StringToWrite then
           	begin
              	FirstBit := Copy(XMLSource, 1, StartPoint - 1);
                 LastBit := Copy(XMLSource, StartPoint + Length(CurrentTag), Length(XMLSource) - (StartPoint + Length(CurrentTag) - 1));
                 if MissingTagList.Count > 0 then
                 	for i := MissingTagList.Count - 1 downto 0 do
                    	StringToWrite := '<' + MissingTagList[i] + '>' + StringToWrite + '</' + MissingTagList[i] + '>';
              	XMLSource := FirstBit + StringToWrite + LastBit;
              end;
        Result := True;
     finally
        MissingTagList.Free;
     end;
  except
  	Result := False;
  end;
end;

function WWriteXMLBoolean(TagPath: WideString; BoolToWrite: Boolean; var XMLSource: WideString): Boolean;
var
BoolString: WideString;

begin
	BoolString := WBoolToStr(BoolToWrite);
  Result := WWriteXMLString(TagPath, BoolString, XMLSource);
end;

function WWriteXMLInteger(TagPath: WideString; IntToWrite: integer; var XMLSource: WideString): Boolean;
var
IntString: WideString;

begin
	IntString := IntToStr(IntToWrite);
  Result := WWriteXMLString(TagPath, IntString, XMLSource);
end;


//Some missing here!

function WReadXMLString(XMLSource, TagPath, DefaultReturn: WideString): WideString;
var
PathList: TTntStringList;
SourceString: WideString;
StartPoint: integer; // needed only for compatibility
i: integer;
FoundTag: Boolean;
TagContents: WideString;

begin
//Set defaults
	Result := DefaultReturn;
	PathList := TTntStringList.Create;
  try
  	if WSplitPath(TagPath, PathList) = False then
     	Exit;

     SourceString := XMLSource;
     FoundTag := False;

     for i := 0 to PathList.Count - 1 do
     	begin
     		FoundTag := WGetTag(PathList[i], SourceString, TagContents, StartPoint, False);
           SourceString := TagContents;
        end;

     if FoundTag = True then
     	Result := SourceString;
  finally
  	PathList.Free;
  end;
end;

function WReadXMLBoolean(XMLSource, TagPath: WideString; DefaultReturn: Boolean): Boolean;
var
BoolString: WideString;
ResultString: WideString;

begin
  try
		BoolString := WBoolToStr(DefaultReturn);
  	ResultString := WReadXMLString(XMLSource, TagPath, BoolString);
  	Result := StrToBool(Trim(ResultString));
  except
  	Result := DefaultReturn;
  end;
end;

function WReadXMLInteger(XMLSource, TagPath: WideString; DefaultReturn: integer): integer;
var
IntString: WideString;
ResultString: WideString;

begin
  try
		IntString := IntToStr(DefaultReturn);
  	ResultString := WReadXMLString(XMLSource, TagPath, IntString);
  	Result := StrToInt(Trim(ResultString));
  except
  	Result := DefaultReturn;
  end;

end;

function WReadXMLReal(XMLSource, TagPath: WideString; DefaultReturn: real): real;
var
RealString: WideString;
ResultString: WideString;

begin
  try
		RealString := FloatToStr(DefaultReturn);
  	ResultString := WReadXMLString(XMLSource, TagPath, RealString);
  	Result := StrToFloat(Trim(ResultString));
  except
  	Result := DefaultReturn;
  end;
end;

function WSaveXMLFile(FilePath: string; XMLData: WideString): Boolean;
var
OutList: TTntStringList;
TokenPosition: integer;
StartPoint: integer;

begin
  if Pos('<?xml', XMLData) < 1 then
		XMLData := WXMLHeader + #13#10#13#10 + XMLData;
	OutList := TTntStringList.Create;
//Following property removed from TTntWideStringList in new TTntStringList implementation
//  OutList.SaveUnicode := True;
  try
     OutList.Text := XMLData;
  	try
  		OutList.SaveToFile(FilePath);
  		Result := True;
  	except
  		Result := False;
  	end;
  finally
  	OutList.Free;
  end;
end;

function WStripTags(InString: WideString): WideString; //Strips all tags out of a piece of text
var
i: integer;
InTag: Boolean;
OutString: WideString;

begin
	OutString := '';
  InTag := False;
	for i := 1 to Length(InString) do
  	begin
     	if InString[i] = '<' then
        	InTag := True;
        if InTag = False then
        	OutString := OutString + InString[i];
        if InString[i] = '>' then
        	InTag := False;
     end;
  Result := OutString;
end;

end.