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
[-]
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, '');
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;
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);
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
![Avatar de Neftali [Germán.Estévez]](image.php?u=3561&dateline=1185205509)
Puedes utilizar una consulta en lugar de un DataSet ?
Mode Lineal
