[Wbarrantes]

me encontre este codigo en varias paginas, sirve para la exportacion a XML, pero tengo problemas con este pues no sirve... aunque la idea general esta muy bien...


adjunto el codigo por si alguien mas avanzado en el tema puede decirme cual es el problema...

variable Global

Código Delphi [-]
  SourceBuffer: PChar;

Código Delphi [-]
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 TForm1.DatasetToXML(Dataset: TDataset; FileName: string);
var
  Stream: TFileStream;
  bkmark: TBookmark;
  i: Integer;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  SourceBuffer := StrAlloc(2048);
  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;

para la ejecucion...

Código Delphi [-]
DatasetToXML(ClientDataSet1 , 'C:/test.xml');

Uso Delphi embarcadero 2010, y el problema que me da es en el archivo final generado... como que incluye espacios en blnco entre cada caracter....


si alguien tiene alguna idea... le agradesco... o si a alguien le corre sin problema, favor decirme para ver si podria ser algo en mi equipo... gracias