由数据库数据生成XML的方法（有源码）[1]

procedure datasettoxml(dataset: tdataset; filename: string);

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, '  ' +
                      '');
  writestring(stream, '');

  {write th metadata}
  with dataset do
    for i := 0 to fieldcount-1 do
    begin
      writestring(stream, '');
    end;
  writestring(stream, '');
  writestring(stream, '');
  writestring(stream, '');
end;

procedure writefileend(stream: tfilestream);
begin
  writestring(stream, '');
end;

procedure writerowstart(stream: tfilestream; isaddedtitle: boolean);
begin
  if not isaddedtitle then
    writestring(stream, '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