Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project BDE2ADO

Project Structure


BDE2ADO.DPR

program Bde2Ado;

uses
  Forms,
  B2AForm in 'B2AForm.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

B2AFORM.PAS

unit B2AForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ADODB, Db, DBTables, ExtCtrls;

type
  TForm1 = class(TForm)
    ADOCommand: TADOCommand;
    ADOConnection: TADOConnection;
    ListBox1: TListBox;
    Panel1: TPanel;
    ComboBox1: TComboBox;
    btnGetStructure: TButton;
    BDETable: TTable;
    ADOTable: TADOTable;
    Memo1: TMemo;
    btnCreateTable: TButton;
    btnMoveData: TButton;
    procedure btnGetStructureClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure btnCreateTableClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure btnMoveDataClick(Sender: TObject);
  private
    function TableExists(TableName: string): Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.btnMoveDataClick(Sender: TObject);
var
  I: Integer;
begin
  BdeTable.Open;
  AdoTable.Open;
  try
    // for each record
    while not BdeTable.Eof do
    begin
      // new record
      AdoTable.Insert;
      // for each field
      for I := 0 to BdeTable.Fields.Count - 1 do
        with BdeTable.Fields [I] do
          AdoTable.FieldByName(Name).Value := Value;
      // post and move on
      AdoTable.Post;
      BdeTable.Next;
    end;
  finally
    BdeTable.Close;
    AdoTable.Close;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Session.GetDatabaseNames (ComboBox1.Items);
  // force an initial list in the listbox
  ComboBox1.Text := 'DBDEMOS';
  ComboBox1Change (Self);
  // select first item
  ListBox1.ItemIndex := 0;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  Session.GetTableNames (ComboBox1.Text, '*.db',
    False, False, ListBox1.Items);
end;

function TForm1.TableExists (TableName: string): Boolean;
var
  TablesList: TStringList;
begin
  // read table names from database
  TablesList := TStringList.Create;
  try
    ADOConnection.GetTableNames (TablesList);
    if TablesList.IndexOf (TableName) >= 0 then
      Result := True
    else
      Result := False;
  finally
    TablesList.Free;
  end;
end;

function AdoTypeName (fdef: TFieldDef): string;
begin
  case fdef.DataType of
    ftString: Result := 'TEXT(' + IntToStr (fdef.Size) + ')';
    ftSmallint: Result := 'SMALLINT';
    ftInteger: Result := 'INTEGER';
    ftWord: Result := 'WORD';
    ftBoolean: Result := 'YESNO';
    ftFloat: Result := 'FLOAT';
    ftCurrency: Result := 'CURRENCY';
    ftDate, ftTime, ftDateTime: Result := 'DATETIME';
    ftAutoInc: Result := 'COUNTER';
    ftBlob, ftGraphic: Result := 'LONGBINARY';
    ftMemo, ftFmtMemo: Result := 'MEMO';
  else
    Result := 'undefined';
  end; // case
end;

procedure TForm1.btnGetStructureClick(Sender: TObject);
var
  strField: string;
  I: Integer;
begin
  // clear output
  Memo1.Lines.Clear;

  // find a new table name
  AdoTable.TableName := (BdeTable.TableName);
  // check if the table already exists
  while TableExists (AdoTable.TableName) do
    AdoTable.TableName := AdoTable.TableName + 'New';
  Memo1.Lines.Add ('create table ' + AdoTable.TableName + ' (');

  // get field information
  BdeTable.FieldDefs.Update;
  for I := 0 to BdeTable.FieldDefs.Count - 1 do
  begin
    strField := '  ' +
      BdeTable.FieldDefs[I].Name + ' ' +
      AdoTypeName (BdeTable.FieldDefs[I]);
    // add comma or parenthesis
    if I < BdeTable.FieldDefs.Count - 1 then
      strField := strField + ','
    else
      strField := strField + ')';
    Memo1.Lines.Add (strField);
  end;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  // close table if open
  BdeTable.Close;
  // set database and table names
  BdeTable.DatabaseName := ComboBox1.Text;
  BdeTable.Tablename :=
    Listbox1.Items [Listbox1.ItemIndex];
end;

procedure TForm1.btnCreateTableClick(Sender: TObject);
begin
  ADOCommand.CommandText :=
    Memo1.Text;
  ADOCommand.Execute;
end;

end.

B2AFORM.DFM

object Form1: TForm1
  Left = 269
  Top = 107
  Width = 628
  Height = 480
  Caption = 'Bde2Ado'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 0
    Top = 33
    Width = 193
    Height = 420
    Align = alLeft
    ItemHeight = 13
    TabOrder = 0
    OnClick = ListBox1Click
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 620
    Height = 33
    Align = alTop
    TabOrder = 1
    object ComboBox1: TComboBox
      Left = 13
      Top = 4
      Width = 172
      Height = 21
      ItemHeight = 13
      TabOrder = 0
      OnChange = ComboBox1Change
    end
    object btnGetStructure: TButton
      Left = 201
      Top = 4
      Width = 80
      Height = 21
      Caption = '&Get Structure'
      TabOrder = 1
      OnClick = btnGetStructureClick
    end
    object btnCreateTable: TButton
      Left = 289
      Top = 4
      Width = 80
      Height = 21
      Caption = '&Create Table'
      TabOrder = 2
      OnClick = btnCreateTableClick
    end
    object btnMoveData: TButton
      Left = 376
      Top = 4
      Width = 80
      Height = 21
      Caption = '&Move Data'
      TabOrder = 3
      OnClick = btnMoveDataClick
    end
  end
  object Memo1: TMemo
    Left = 208
    Top = 48
    Width = 393
    Height = 385
    TabOrder = 2
  end
  object ADOCommand: TADOCommand
    CommandText =
       'create table employees ('#13#10'  EmpNo COUNTER,'#13#10'  FirstName TEXT(30)'     +
      ','#13#10'  LastName TEXT(30),'#13#10'  PhoneExt TEXT (5),'#13#10'  HireDate DATETI'       +
      'ME,'#13#10'  Salary CURRENCY);'
      Connection = ADOConnection
    Parameters = <>
    Left = 72
    Top = 208
  end
  object ADOConnection: TADOConnection
    ConnectionString =
       'Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=C:\md' +
      '5code\Part3\11\data\MdData.mdb;Mode=Share Deny None;Extended Pro' +
      'perties="";Locale Identifier=1033;Persist Security Info=False;Je' +
      't OLEDB:System database="";Jet OLEDB:Registry Path="";Jet OLEDB:' +
      'Database Password="";Jet OLEDB:Engine Type=4;Jet OLEDB:Database ' +
      'Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Glo' +
      'bal Bulk Transactions=1;Jet OLEDB:New Database Password="";Jet O' +
      'LEDB:Create System Database=False;Jet OLEDB:Encrypt Database=Fal' +
      'se;Jet OLEDB:Don''t Copy Locale on Compact=False;Jet OLEDB:Compac'    +
      't Without Replica Repair=False;Jet OLEDB:SFP=False'
    LoginPrompt = False
    Provider = 'Microsoft.Jet.OLEDB.4.0'
    Left = 72
    Top = 152
  end
  object BDETable: TTable
    Left = 72
    Top = 88
  end
  object ADOTable: TADOTable
    Connection = ADOConnection
    Left = 72
    Top = 264
  end
end