Search code examples
delphisqlitedelphi-xe5

Data from .DBF File Not Copying To SQLite File


I am using Delphi XE5 with Windows 7 OS.

I have .dbf file and this file data I need to move to SQLite file.

Observation: When I import this file in NaviCat for SQLite, there I see data in ASCII format. While Copying data from ADODataset (which hold the data from .dbf file), I see ftWideString and ftWideMemo, am I making mistake while assigning appropriate data type for "Query" component which is of type TFDQuery? But it is not the case always i.e. .dbf file could also contains normal alpha numeric characters also. Intention is to post any type of data from .dbf file to SQLite file.

Below procedure post the data into SQLite file, I am not getting any error while posting the data but when I open the SQLite file in NaviCat, I don't see blank record.

procedure TfrmMainForm.InsertDatabtnClick(Sender: TObject);

I am trying with below code:

Code:

const
  MyDBFile = 'C:\TempDB\MYSQLightDB.db';

type
  TfrmMainForm = class(TForm)
    ADOConnection1: TADOConnection;
    CreateTablebtn: TButton;
    ADODataSet1: TADODataSet;
    DataSource1: TDataSource;
    FDGUIxWaitCursor1: TFDGUIxWaitCursor;
    InsertDatabtn: TButton;
    FDQuery1: TFDQuery;
    SQLConnection1: TSQLConnection;
    ADODataSet2: TADODataSet;

    procedure CreateTablebtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure InsertDatabtnClick(Sender: TObject);
  private
    { Private declarations }
    Connection : TFDConnection;
    DriverLink : TFDPhysSQLiteDriverLink;
    Table : TFDTable;
    Query : TFDQuery;
  public
    { Public declarations }
  end;

var
  frmMainForm: TfrmMainForm;

implementation

{$R *.dfm}


procedure TfrmMainForm.FormShow(Sender: TObject);
begin
  CreateComponents;
end;

procedure TfrmMainForm.CreateTablebtnClick(Sender: TObject);
begin
  ConnectTodatabaseFile;
end;

procedure TfrmMainForm.ConnectTodatabaseFile;
var
  dbf_folder : string;
begin
  dbf_folder:='C:\TempDB';//set your dbf folder location here
  ADOConnection1.LoginPrompt:=false;
  ADOConnection1.ConnectionString:=Format('Provider=Microsoft.JET.OLEDB.4.0;Data Source=%s;Extended Properties=dBase IV;',[dbf_folder]);
  ADODataSet1.ConnectionString:=Format('Provider=Microsoft.JET.OLEDB.4.0;Data Source=%s;Extended Properties=dBase IV;',[dbf_folder]);
  try
    ADOConnection1.Connected:=True;
    ADODataSet1.CommandText:='Select * from MyFileName.dbf'; //make your SQL query using the name of the dbf file
    ADODataSet1.Open;

    CreateSQLiteTable;

    ShowMessage('Table created successfully');
  except
    on E : Exception do
      ShowMessage(E.Message);
  end;
end;

procedure TfrmMainForm.CreateSQLiteTable;
var
  FFieldName, FCreateSQL : string;
  FColumnCount : Integer;
begin
  FCreateSQL := 'Create Table MyTable1 (';
  for FColumnCount := 0 to ADODataSet1.FieldCount - 1 do
  begin
    FFieldName := ADODataSet1.Fields[FColumnCount].FieldName;
    FCreateSQL := FCreateSQL + FFieldName + ' ' + FieldTypeToSQLString(ADODataSet1.Fields[FColumnCount].DataType, ADODataSet1.Fields[FColumnCount].DataSize);

    if FColumnCount <> ADODataSet1.FieldCount - 1 then
      FCreateSQL := FCreateSQL + ', ';
  end;

  FCreateSQL := FCreateSQL + ')';

  Query.Close;
  Query.SQL.Clear;
  Query.SQL.Add(FCreateSQL);
  Query.ExecSQL;
end;

procedure TfrmMainForm.InsertDatabtnClick(Sender: TObject);
var
  FSQLString : String;
  FColumnCount : Integer;
begin
  Query.Close;
  Query.CachedUpdates := True;
  Query.SQL.Clear;
  Query.SQL.Add('Select * from MyTable1 where 1 = 2');
  Query.Active := True;

  ADODataSet1.First;
  while not ADODataSet1.eof do
  begin
    Query.Insert;

    for FColumnCount := 0 to ADODataSet1.FieldCount - 1 do
    begin
      Query.Fields[FColumnCount].Value := ADODataSet1.Fields[FColumnCount].Value;
    end;

    ADODataSet1.Next;
  end;

  Query.Edit;
  Query.Post;
  Query.CommitUpdates;

  ShowMessage('Data Inserted');
end;

procedure TfrmMainForm.CreateComponents;
begin
  DriverLink := TFDPhysSQLiteDriverLink.Create(Self);
  Connection := TFDConnection.Create(self);

  Connection.Params.Values['DriverID'] := 'SQLite';
  Connection.Params.Values['Database'] := MyDBFile;
  Connection.Connected := True;

  Table := TFDTable.Create(self);
  Query := TFDQuery.Create(self);

  Query.Connection := Connection;
  Table.Connection := Connection;
end;

procedure TfrmMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  DeleteComponents;
end;

procedure TfrmMainForm.DeleteComponents;
begin
  Connection.Free;
  DriverLink.Free;
  Table.Free;
  Query.Free;
end;

Function TfrmMainForm.FieldTypeToSQLString(T : TFieldType; L : Longint) : String;
Begin
  case T of
    ftString : Result := 'VARCHAR('+IntToStr(L)+')';
    ftSmallint : Result := 'SMALLINT';
    ftInteger : Result := 'INTEGER';
    ftWord : Result := 'SMALLINT';
    ftBoolean : Result := 'BOOLEAN';
    ftFloat : Result := 'FLOAT';
    ftCurrency : Result := 'MONEY';
    ftBCD : Result := 'DECIMAL';
    ftDate : Result := 'DATE';
    ftTime : Result := 'TIME';
    ftDateTime : Result := 'TIMESTAMP';
    ftBytes : Result := 'BLOB('+IntToStr(L)+',2)';
    ftVarBytes : Result := 'BLOB('+IntToStr(L)+',2)';
    ftAutoInc : Result := 'AUTOINC';
    ftBlob : Result := 'BLOB('+IntToStr(L)+',1)';
    ftMemo : Result := 'BLOB('+IntToStr(L)+',1)';
    ftGraphic : Result := 'BLOB('+IntToStr(L)+',5)';
    ftFmtMemo : Result := 'BLOB('+IntToStr(L)+',3)';
    ftParadoxOle : Result := 'BLOB('+IntToStr(L)+',4)';
    ftDBaseOle : Result := 'BLOB('+IntToStr(L)+',4)';
    ftTypedBinary : Result := 'BLOB('+IntToStr(L)+',2)';
    ftFixedChar : Result := 'CHAR('+IntToStr(L)+')';
    ftWideString : Result := 'VARCHAR('+IntToStr(L)+')';
    ftWideMemo : Result := 'NTEXT';
    ftLargeInt : Result := 'INTEGER'
  else
    Result := 'UNKNOWN!';
  end;
End;

end.

Solution

  • I got it resolved in another way by modifying the procedure mentioned in the problem. Just added below statement before comiting changes to the database.

    Query.ApplyUpdates(0);
    

    And "Query.Post;" statement is not needed in the loop.

    Complete procedure:

    procedure TfrmMainForm.InsertDatabtnClick(Sender: TObject);
    var
      FSQLString : String;
      FColumnCount : Integer;
    begin
      Query.Close;
      Query.CachedUpdates := True;
      Query.SQL.Clear;
      Query.SQL.Add('Select * from MyTable1 where 1 = 2');
      Query.Active := True;
    
      ADODataSet1.First;
      while not ADODataSet1.eof do
      begin
        Query.Insert;
    
        for FColumnCount := 0 to ADODataSet1.FieldCount - 1 do
        begin
          Query.Fields[FColumnCount].Value := ADODataSet1.Fields[FColumnCount].Value;
        end;
    
        ADODataSet1.Next;
      end;
    
      Query.ApplyUpdates(0);
      Query.CommitUpdates;
    
      ShowMessage('Data Inserted');
    end;