Dicas - Exportando para XML

Você precisa estar logado para dar um feedback. Clique aqui para efetuar o login
Para efetuar o download você precisa estar logado. Clique aqui para efetuar o login
Confirmar voto
0
 (0)  (0)

Dica de como exportar dados de um DataSet para XML.

Exportando dados para um arquivo XML

 

Confira nas linhas de código abaixo como exportar dados com o Delphi para um arquivo XML.

 

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, '      Generated by SMExport --> ' +

     '');

     WriteString(Stream, '');

 

   {write th metadata}

   with Dataset do

    for i := 0 to FieldCount - 1 do

    begin

     WriteString(Stream, '     Fields[i].FieldName +

     '" fieldtype=' +

     XMLFieldType(Fields[i]) +

     '/>');

    end;

     WriteString(Stream, '');

     WriteString(Stream, '      LCID="1033"/>');

     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 TForm1.DatasetToXML(Dataset: TDataSet; FileName: string);

var

  Stream: TFileStream;

  bkmark: TBookmark;

  i: Integer;

begin

  Form1.Cursor := crHourGlass;

 

  Stream := TFileStream.Create(FileName, fmCreate);

  SourceBuffer := StrAlloc(1024);

  WriteFileBegin(Stream, Dataset);

 

with DataSet do

begin

  DisableControls;

  bkmark := GetBookmark;

  First;

  WriteRowStart(Stream, True);

  for i := 0 to FieldCount - 1 do

    WriteData(Stream, nil, Fields[i].DisplayLabel);

  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]));

 

  WriteRowEnd(Stream, False);

 

  Next;

end;

 

GotoBookmark(bkmark);

      EnableControls;

end;

 

  WriteFileEnd(Stream);

  Stream.Free;

  StrDispose(SourceBuffer);

 

  Form1.Cursor := crDefault

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

    DatasetToXML(Table1, 'clubedelphi.xml');

end;

 

Confira nas imagens abaixo, um aplicativo de exemplo.

 

Figura 1. O aplicativo.

 

Figura 2. O arquivo XML criado.

 
Você precisa estar logado para dar um feedback. Clique aqui para efetuar o login
Ficou com alguma dúvida?