Fórum como gravar em XML #348917

unit UPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBClient, ExtCtrls, DBCtrls, Grids, DBGrids, StdCtrls, Buttons,
  FIBDatabase, pFIBDatabase, FIBDataSet, pFIBDataSet;

type
  TForm1 = class(TForm)
    tbDicionario: TClientDataSet;
    tbDicionarioTB_Antiga: TStringField;
    tbDicionarioCA_Antigo: TStringField;
    tbDicionarioTI_Antigo: TStringField;
    tbDicionarioTB_Novo: TStringField;
    tbDicionarioCA_Novo: TStringField;
    tbDicionarioTI_Novo: TStringField;
    DBGrid1: TDBGrid;
    DBNavigator1: TDBNavigator;
    dsDicionario: TDataSource;
    SpeedButton1: TSpeedButton;
    opOrigem: TOpenDialog;
    Label1: TLabel;
    edtCaminhoBD: TEdit;
    SpeedButton2: TSpeedButton;
    dbAntigo: TpFIBDatabase;
    tbAntigo: TpFIBDataSet;
    trAntigo: TpFIBTransaction;
    SpeedButton3: TSpeedButton;
    dlgSalvar: TSaveDialog;
    tbDicionarioOrdem: TIntegerField;
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

////////// Procedures //////////// 
function RetornaTipo(Campo:TFieldType):string;
begin
   case campo  of
     ftUnknown: result:=´Desconhecido´ ;
     ftString: result := ´Varchar´;
     ftSmallint: result := ´Integer´;
     ftInteger: result := ´Integer´ ;
     ftWord: result := ´Integer´;
     ftBoolean: result := ´Char(1)´;
     ftFloat: result :=´DOUBLE PRECISION´; 
     ftCurrency: result :=´DOUBLE PRECISION´;
     ftBCD: result :=´DOUBLE PRECISION´; 
     ftDate: result :=´Timestamp´;
     ftTime: result :=´TimeStamp´; 
     ftDateTime: result :=´TimeStamp´;
     ftBytes: result :=´integer´ ; 
     ftVarBytes: result :=´integer´;
     ftAutoInc: result :=´Integer´; 
     ftBlob: result :=´Blob´;
     ftMemo: result :=´Blob´;
     ftGraphic: result :=´Blob´;
     ftFmtMemo: result :=´Blob´; 
     ftParadoxOle: result :=´Blob´; 
     ftDBaseOle: result :=´Blob´;
     ftTypedBinary: result :=´Integer´; 
     ftCursor: result :=´Integer´;
     ftFixedChar: result :=´Char´;
     ftWideString: result :=´Varchar´;
     ftLargeint: result :=´integer´; 
     ftADT: result :=´blob´;
     ftArray: result :=´blob´;
     ftReference: result :=´blob´; 
     ftDataSet: result :=´blob´;
     ftOraBlob: result :=´Blob´;
     ftOraClob: result :=´Blob´; 
     ftVariant: result :=´blob´;
     ftInterface: result :=´blob´;
     ftIDispatch: result :=´´;
     ftGuid: result :=´´; 
     ftTimeStamp: result :=´TimeStamp´;
     ftFMTBcd: result :=´blob´;
     ftFixedWideChar: result :=´Char´; 
     ftWideMemo: result :=´Blob´;
     ftOraTimeStamp: result :=´TimeStamp´;
     ftOraInterval: result :=´integer´;
   end;
end;

//Carrega os dados do banco de dados antigo para a tabela em XML
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
    TabelasBDANTIGO_Temp     : TStringList;
    CamposBDANTIGO_Temp     : TStringList;
    I,J:integer;
begin
   try
      if trim(edtCaminhoBD.Text)= ´´ then
      begin
          ShowMessage(´Preencha o caminho do banco de dados´);
          exit;
      end;
      
      //Conexao com o Banco
      dbAntigo.DBName                   := ´localhost:´+ edtCaminhoBD.Text;
      dbAntigo.ConnectParams.UserName   := ´SYSDBA´;
      dbAntigo.ConnectParams.Password   := ´masterkey´;
      dbAntigo.SQLDialect := 3;
      dbAntigo.Connected := TRUE;
      TabelasBDANTIGO_Temp    := TStringList.Create;
      CamposBDANTIGO_Temp    := TStringList.Create;
      dbAntigo.GetTableNames(TabelasBDANTIGO_Temp, FALSE);  // Armazenando o nome das tabelas na variavel.
      tbDicionario.Open;
      for I := 0 to TabelasBDANTIGO_Temp.Count - 1 do
      Begin
        tbAntigo.Active := False;
        tbAntigo.SQLs.SelectSQL.Clear;
        tbAntigo.SQLs.SelectSQL.Add(´SELECT FIRST 1 * FROM ´+TabelasBDANTIGO_Temp.Strings[I]);
        tbAntigo.Active := True;
        trAntigo.StartTransaction;
        tbAntigo.GetFieldNames(CamposBDANTIGO_Temp);           // Armazenando o nome dos campos na variavel.
        for J := 0 to CamposBDANTIGO_Temp.Count - 1 do  begin
             tbDicionario.Insert;
             tbDicionario.FieldByName(´TB_ANTIGO´).AsString:= TabelasBDANTIGO_Temp.Strings[I];
             tbDicionario.FieldByName(´CA_ANTIGO´).AsString:= CamposBDANTIGO_Temp[J];
             tbDicionario.FieldByName(´TI_ANTIGO´).AsString:= RetornaTipo(tbAntigo.Fields[J].DataType);
             tbDicionario.FieldByName(´TB_NOVO´).AsString:= TabelasBDANTIGO_Temp.Strings[I];
             tbDicionario.FieldByName(´CA_NOVO´).AsString:= camposBDANTIGO_Temp[J];
             tbDicionario.FieldByName(´TI_NOVO´).AsString:= RetornaTipo(tbAntigo.Fields[J].DataType);
             tbDicionario.Post;

        end;
      end;
      ShowMessage(´Dicionários importado com sucesso´);
   except
       ShowMessage(´Erro na importação´);
   end;

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  if opOrigem.Execute then
  begin
     edtCaminhoBD.Text:=opOrigem.FileName;
end;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  if dlgSalvar.Execute then
  begin
      tbDicionario.SaveToFile(dlgSalvar.FileName);
      ShowMessage(´Arquivo gravado com sucesso ´);
  end;
end;

end.