Home: Code Repository: Mastering Delphi 5

Project BDE2ADO

Project Structure

BDE2ADO.DPR
B2AFORM.PAS
B2AFORM.DFM

program Bde2Ado;

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

{$R *.RES}

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

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.

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