Как сделать экспорт TDataSet в XML file?

=== Как сделать экспорт TDataSet в XML file? ===
{ Unit to export a dataset to XML }
unit DS2XML;
interface
uses
 Classes, DB;
procedure DatasetToXML(Dataset: TDataSet; FileName: string);
implementation
uses
 SysUtils;
var
 SourceBuffer: PChar;
procedure WriteString(Stream: TFileStream; s: string);
begin
 StrPCopy(SourceBuffer, s);
 Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
end;
procedure WriteFileBegin(Stream: TFileStream; Dataset: TDataSet);
 function XMLFieldType(fld: TField): string;
 begin
 case fld.DataType of
 ftString: Result := '"string" WIDTH="' + IntToStr(fld.Size) + '"';
 ftSmallint: Result := '"i4"'; //??
 ftInteger: Result := '"i4"';
 ftWord: Result := '"i4"'; //??
 ftBoolean: Result := '"boolean"';
 ftAutoInc: Result := '"i4" SUBTYPE="Autoinc"';
 ftFloat: Result := '"r8"';
 ftCurrency: Result := '"r8" SUBTYPE="Money"';
 ftBCD: Result := '"r8"'; //??
 ftDate: Result := '"date"';
 ftTime: Result := '"time"'; //??
 ftDateTime: Result := '"datetime"';
 else
 end;
 if fld.Required then
 Result := Result + ' required="true"';
 if fld.ReadOnly then
 Result := Result + ' readonly="true"';
 end;
var
 i: Integer;
begin
 WriteString(Stream, '<?xml version="1.0" standalone="yes"?><!-- Generated by SMExport --> ' +
 '<DATAPACKET Version="2.0">');
 WriteString(Stream, '<METADATA><FIELDS>');
 { write th metadata }
 with Dataset do
 for i := 0 to FieldCount - 1 do
 begin
 WriteString(Stream, '<FIELD attrname="' +
 Fields[i].FieldName +
 '" fieldtype=' +
 XMLFieldType(Fields[i]) +
 '/>');
 end;
 WriteString(Stream, '</FIELDS>');
 WriteString(Stream, '<PARAMS DEFAULT_ORDER="1" PRIMARY_KEY="1" LCID="1033"/>');
 WriteString(Stream, '</METADATA><ROWDATA>');
end;
procedure WriteFileEnd(Stream: TFileStream);
begin
 WriteString(Stream, '</ROWDATA></DATAPACKET>');
end;
procedure WriteRowStart(Stream: TFileStream; IsAddedTitle: Boolean);
begin
 if not IsAddedTitle then
 WriteString(Stream, '<ROW');
end;
procedure WriteRowEnd(Stream: TFileStream; IsAddedTitle: Boolean);
begin
 if not IsAddedTitle then
 WriteString(Stream, '/>');
end;
procedure WriteData(Stream: TFileStream; fld: TField; AString: ShortString);
begin
 if Assigned(fld) and (AString <> ) then
 WriteString(Stream, ' ' + fld.FieldName + '="' + AString + '"');
end;
function GetFieldStr(Field: TField): string;
 function GetDig(i, j: Word): string;
 begin
 Result := IntToStr(i);
 while (Length(Result) < j) do
 Result := '0' + Result;
 end;
var
 Hour, Min, Sec, MSec: Word;
begin
 case Field.DataType of
 ftBoolean: Result := UpperCase(Field.AsString);
 ftDate: Result := FormatDateTime('yyyymmdd', Field.AsDateTime);
 ftTime: Result := FormatDateTime('hhnnss', Field.AsDateTime);
 ftDateTime:
 begin
 Result := FormatDateTime('yyyymmdd', Field.AsDateTime);
 DecodeTime(Field.AsDateTime, Hour, Min, Sec, MSec);
 if (Hour <> 0) or (Min <> 0) or (Sec <> 0) or (MSec <> 0) then
 Result := Result + 'T' + GetDig(Hour, 2) + ':' + GetDig(Min,
 2) + ':' + GetDig(Sec, 2) + GetDig(MSec, 3);
 end;
 else
 Result := Field.AsString;
 end;
end;
procedure DatasetToXML(Dataset: TDataSet; FileName: string);
var
 Stream: TFileStream;
 bkmark: TBookmark;
 i: Integer;
begin
 Stream := TFileStream.Create(FileName, fmCreate);
 SourceBuffer := StrAlloc(1024);
 WriteFileBegin(Stream, Dataset);
 with DataSet do
 begin
 DisableControls;
 bkmark := GetBookmark;
 First;
 { write a title row }
 WriteRowStart(Stream, True);
 for i := 0 to FieldCount - 1 do
 WriteData(Stream, nil, Fields[i].DisplayLabel);
 { write the end of row }
 WriteRowEnd(Stream, True);
 while (not EOF) do
 begin
 WriteRowStart(Stream, False);
 for i := 0 to FieldCount - 1 do
 WriteData(Stream, Fields[i], GetFieldStr(Fields[i]));
 { write the end of row }
 WriteRowEnd(Stream, False);
 Next;
 end;
 GotoBookmark(bkmark);
 EnableControls;
 end;
 WriteFileEnd(Stream);
 Stream.Free;
 StrDispose(SourceBuffer);
end;
end.
// Beispiel, Example:
uses DS2XML;
procedure TForm1.Button1Click(Sender: TObject);
begin
 DatasetToXML(Table1, 'test.xml');
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02635