Exportacion a XML
 

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

Hola; Lo primero decir que al colocar el código con los TAG's de Delphi (seguramente por un error en el parser) faltan cosas y el código ha quedado incorrecto (revisar el procedimiento WriteFileEnd, por ejemplo).

Lo coloco con las etiquetas CODE, por si alguien quiere copiarlo.

En cuanto a tu problema, es posible que esté a la hora de definir tipos de datos. Fíjate con no están ftWideString, ftLargeInt,...
He añadido esto al else:

Código Delphi [-]
   Result := '"TIPO-DESCONOCIDO"';

Que te debería ayudar a detectar si ese es tu problema. Por lo demás yo lo he probado y parece que el código funciona bien.

Puedes utilizar una consulta en lugar de un DataSet ?
 

Puedes utilizar una consulta en lugar de un DataSet ?

Creo tener idea de como corregir el problema, ¿ puedes poner el resultado que obtienes en el XML ?

¿Puedes poner los datos que son usados en el DataSet?

Gracias.

Cualquier TQuery, TTable, TADOTable,... deriva de un DataSet, por lo tanto puedes utilizarlo con el resultado de un quey sin problemas (así lo he probado yo).

Muchas gracias Neftali
 

Muchas gracias Neftali:)

Duda acerca de nodos XML
 

Hola.

Intentando de otra forma he obtenido la siguiente estructura en el XML.

Lo que necesito es que despues de el nodo Field se despliegue otro nodo llamado Fields de la siguiente manera:

He intentado de muchas formas pero no he logrado mi proposito.:confused:

Muchas gracias.:)

el resultado que me da el archivo XML es:



a cuales datos te refieres?

el dataset ejecuta una consulta de la tabla Personas(para este ejemplo especifico), y contiene...

Código SQL [-]
SELECT [Nombre]
      ,[Apellido1]
      ,[Apellido2]
      ,[Cedula]
      ,[FULLNAME]
  FROM [Prueba].[dbo].[Persona]

pobre con los cambios de Neftali pero nada.. sigue igual... por cierto gracias por las prontas respuestas...

Neftali...
 

Pues efectivamente no tengo contemplado el ftWideString, como podria agregarlo?

En el Case:

Código Delphi [-]
  case fld.DataType of

Habría que ir añadiendo los que faltan; Por ejemplo, al final puedes poner:

Código Delphi [-]
    ftLargeInt: Result := '"i8"';
    ftWideString: Result := '"string" WIDTH="' + IntToStr(fld.Size) + '"';

Neftali
 

ok, genial, ya agregue los valores que hacian falta, (por cierto de donde tomas la tabla equivalencia de los valores, podria serme util en un futuro...)...

Pero sigo teniendo el problema en el archivo generado... como que mete un espacio en blanco entre cada caracter, antes de escribir el archivo xml... y ademas lo corta...

por ejemplo la primera linea queda en el archivo
y deberia ser...

como pueden ver se corta en "Gener", no termina de escribir toda la sentencia "Generated by SMExport -->"... se que en esta linea esto no es importante, a exepcion de los reconocimientos de los creditos... pero es un ejemplo, pues hace lo mismo con el resto de lineas en el archivo...

En mi caso de la ayuda de SQL Server, pero supongo que por internet si buscas deben estar.

En cuanto a los espacios no lo entiendo, porque eso lo añade esta línea que parece bastante "inofensiva". :confused::confused:

muy confundido???
 

:confused:
si de echo alli tengo misdudas pues debugeando, la informacion entra nitida....

tengo office 2007 y windows XP, y Delphi 2010 (con licencia)... no veo que pueda estar fallando... y ya pobre el ejecutable en otras maquinas y nada...

WriteString

Código Delphi [-]
 
procedure WriteString(Stream: TFileStream; s: string);
begin
  StrPCopy(SourceBuffer, s);
  Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
end;

Write

Código Delphi [-]
function THandleStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result := FileWrite(FHandle, Buffer, Count);
  if Result = -1 then Result := 0;
end;

de echo cuando trate de revisar el ejemplo para escribir en excell, tambien me dio este tipo de problemas... me ponia un caracter con signo de pregunta, entre cada caracter de la cadena del string, que deseabaguardar en una celda...

pero ya lo he probado, tambien en otras maquinas con configuraciones diferentes, lo que me lleva a pensar que podrian ser la unidades, mas bien...

¿No estará relacionado con Unicode?
Lo digo por los 2 caracteres en lugar de 1.

pos la verdad no se...
 

pos la verdad, en este momento, ya no me queda piedra sin revisar... al menos hasta donde mi "malicia indigena" alcanza...

inicailmente pense que podria estar cortando la cadena por el tamano del

Código Delphi [-]
SourceBuffer := StrAlloc(1024);

por lo que lo triplique...

Código Delphi [-]
SourceBuffer := StrAlloc(4096);

pero el resultado es el mismo...

estoy en un 98% convencido que el problema viene dado por el Stream, lo que me tiene chichoso, es que el problema no parece tenerlo nadie mas en este foro... pero si cambio de equipo y lo intento de nuevo, yo sigo teniendo problemas...

resp
 

Carga los datos en un cliendataset y lo guardas como xml esta atarea el clien dataset la hace solita.