Transformador de Dados de tabelas em XML
15/07/2005
0
obs: Este serve para qualquer conexao : IBX , DBExpress , Zeos ele so pega DataSet .
//Funçao de selecao de dados procedure TForm1.btnEmitirClick(Sender: TObject); begin ClientDataSet1.close ; ClientDataSet1.open ; if converteParaXML_Puro( ClientDataSet1, ExtractFileDir( Application.ExeName ) +´\´+ ´Empenhos.XML´) then ShowMessage ( ´Tabela Convertida para XML , com sucesso ! ´ + chr(13)+ ´Arquivo gerado em : ´+ ExtractFileDir( Application.ExeName ) +´\´+ ´Empenhos.XML´) ; ClientDataSet1.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;
Elter.teodoro
Curtir tópico
+ 0
Responder
Clique aqui para fazer login e interagir na Comunidade :)