Fórum Como converte uma Tabela para um arquivo XML puro #288278

Como converte uma Tabela , com conexao atraves de BDE para um XML .

obs: Este server para qualquer conexao : BDE, ADO , IBX , DBExpress , Zeos


//Funçao de selecao de dados
procedure TForm1.btnEmitirClick(Sender: TObject);
begin
Query1.close ;
Query1.ParamByName(´DataInicial´).AsDateTime := DataInicial.Date ;
Query1.ParamByName(´DataFinal´).AsDateTime := DataFinal.Date ;

Query1.open ;
if converteParaXML_Puro( Query1, ExtractFileDir( Application.ExeName ) +´\´+ ´Empenhos.XML´) then
ShowMessage ( ´Tabela Convertida para XML , com sucesso ! ´ + chr(13)+ ´Arquivo gerado em : ´+ ExtractFileDir( Application.ExeName ) +´\´+ ´Empenhos.XML´) ;
Query1.close ;
end;


function ConverteParaXML(Tabela: TDataSet; ArquivoDestino: string): boolean;
Var
I : integer ;
ListaCampos : TStringList ;
mArquivo : TextFile;
ListaXML : string ;
begin
Result := False ;

AssignFile(mArquivo, ArquivoDestino);
Rewrite(mArquivo);

Tabela.close ;
Tabela.open ;

ListaCampos := TStringList.Create ;

Writeln( mArquivo , ´<?xml version=´1.0´?>´);
Writeln( mArquivo , ´<CADASTRO>´);

While not Tabela.Eof do
begin
Writeln( mArquivo , ´<DADOS>´);
for i := 0 to Tabela.FieldCount -1 do
begin
ListaXML := ´<´+ Tabela.Fields[i].FieldName + ´>´+ RetiraCaracteres_Invalidos( Tabela.fieldbyName( Tabela.Fields[i].FieldName).AsString ) +´</´+ Tabela.Fields[i].FieldName + ´>´ ;
Writeln( mArquivo , ListaXML ) ;
end ;
Writeln( mArquivo ,´</DADOS>´);
Tabela.Next ;
end;

Writeln( mArquivo ,´</CADASTRO>´);

CloseFile(mArquivo);
ListaCampos.Free ;

Result := True ;
end;

function RetiraCaracteres_Invalidos( Texto: string): string;
Var
I : integer ;
Letra : string ;
TempTexto : string ;
begin
result := StringReplace(Texto ,´ç´, ´c´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´ã´, ´a´, [ rfReplaceAll ] ) ;

result := StringReplace(result ,´Ã´, ´A´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´Ç´, ´C´, [ rfReplaceAll ] ) ;

result := StringReplace(result ,´á´, ´a´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´é´, ´e´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´í´, ´i´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´ó´, ´o´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´ú´, ´u´, [ rfReplaceAll ] ) ;

result := StringReplace(result ,´Á´, ´A´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´É´, ´E´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´Í´, ´I´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´Ó´, ´O´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´Ú´, ´U´, [ rfReplaceAll ] ) ;

result := StringReplace(result ,´â´, ´a´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´ê´, ´e´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´ô´, ´o´, [ rfReplaceAll ] ) ;

result := StringReplace(result ,´Â´, ´A´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´Ê´, ´E´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´Ô´, ´O´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´&´, ´e´, [ rfReplaceAll ] ) ;
result := StringReplace(result ,´´´, ´,´, [ rfReplaceAll ] ) ;

TempTexto := result ;

result := ´´ ;

for I := 1 to Length(TempTexto) do
begin
Letra := copy ( TempTexto ,i,1);
if ( ord( Letra[1] ) in [33..126] ) And
( ord( Letra[1] ) <> 38 ) And
( ord( Letra[1] ) <> 60 ) And
( ord( Letra[1] ) <> 62 ) And
( ord( Letra[1] ) <> 94 ) then
result := result + copy ( TempTexto ,i,1)
else
result := result + ´ ´ ;
end ;
end;