Solved

Access database

Posted on 2000-03-16
7
198 Views
Last Modified: 2010-04-04
How can I create Access database with
two tables ???
0
Comment
Question by:zeko
  • 3
  • 3
7 Comments
 
LVL 2

Expert Comment

by:florisb
ID: 2623503
from Delphi or within Access?
0
 

Author Comment

by:zeko
ID: 2624832
FROM Delphi 5.0
0
 
LVL 2

Accepted Solution

by:
gallaghe earned 50 total points
ID: 2655044
Below is working code tested with D3 and D4. DFM code can be converted from text to DFM if needed with Delphi's convert utiilty in the Delphi bin directory.

Although you asked for two tables I went a one more. Also shows how to see if the table you want to create already exist or not, if so it shows how to delete it from the MDB. Other code includes creation of indexes.

All is done with late binding. No need here for early binding. It could be done but IMHO not worth the effort.

PASCAL
unit MainForm;

{*****************************************************************************}
{ Programmer:                                                                 }
{ Kevin S. Gallagher gallaghe@teleport.com                                    }
{                    kevin.s.gallagher@state.or.us                            }
{                                                                             }
{ Description:                                                                }
{ Demo showing how to                                                         }
{   1.  Create a new MS-Access database                                       }
{   2.  Create several tables with primary and secondary indexs               }
{                                                                             }
{ Comments:                                                                   }
{ * I used D4 along with MS-Office 97/ DAO 3.5 to create the demo.            }
{ * ComObj was added manually to this unit.                                   }
{                                                                             }
{ KSG 03/24/00                                                                }
{ Modified to create several tables rather then one, made changes in D3.      }
{*****************************************************************************}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    cmdCreate: TButton;
    cmdExit: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure cmdCreateClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cmdExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    Dbs,
    DBEngine,
    Workspace: Variant ;
    function CreateMDB(cDatabaseName: String): boolean ;
    function CreateRecordSet(cTableName: String): boolean ;
    function InitAccess: boolean ;
  public
    { Public declarations }
    function TableExistInMDB(vDbs:Variant; aTable:String):boolean ;
  end;


var
  Form1: TForm1;

implementation

{$R *.DFM}


uses ComObj ; { Manually added this }

procedure ErrorMsg(cMessage:String) ;
begin
  MessageDlg(cMessage,mtError,[mbOk],0) ;
end ;

{ Used to determine if a recordset exist in the currently opened database.
  You might want to check if the database variable 'vDbs' is valid, I have
  elected not too. }
function TForm1.TableExistInMDB(vDbs:Variant; aTable:String):boolean ;
var i:Integer ;
begin
  Result := False ;
  try
    for I := 0 to vdbs.TableDefs.Count  do
      if UpperCase(vdbs.TableDefs.Item[I].Name) = UpperCase(aTable) then
      begin
        Result := True ;
        break ;
      end ;
  except
    Result := False ;
  end ;
end ;

{ Grab a reference to either an open copy of Access or create a reference
  if not available. If we can not get a reference we return False and the
  caller must deal with this. }
function TForm1.InitAccess: boolean ;
begin
  Result := True ;
  try
    dbEngine := GetActiveOleObject('DAO.DBEngine.35') ;
  except
    dbEngine := CreateOLEObject('DAO.DBEngine.35') ;
  end;
  if VarIsEmpty(dbEngine) then
    Result := False ;
end ;

{ Creates an empty MS-Access database }
function TForm1.CreateMDB(cDatabaseName: String): boolean ;
const
  dbLangGeneral = ';LANGID=0x0409;CP=1252;COUNTRY=0' ;
  dbVersion = 32 ;
begin
  if FileExists(cDatabaseName + '.mdb') then
    if not DeleteFile(cDatabaseName + '.mdb') then
    begin
      ErrorMsg('Failed to remove' + #13 + cDatabaseName + '.mdb') ;
      Result := False ;
      exit ;
    end ;

  Workspace := DBEngine.Workspaces[0] ;
  try
    { Create the MDB }
    Workspace.CreateDatabase(cDatabaseName, dbLangGeneral, dbVersion) ;
    dbs := dbEngine.OpenDatabase(cDatabaseName) ;
    Result := True ;
  except
    ErrorMsg('Failed to create' + #13 + cDatabaseName + '.mdb') ;
    Result := False  ;
    exit ;
  end ;
end ;

{ Create a recordset with a fix structure.  }
function TForm1.CreateRecordSet(cTableName:String): boolean ;
const
  { Gotten from MS-Access Object Inspector or via MSAccess TypeLibrary }
  dbInteger = 3 ;
  dbText = 10 ;
  dbLongBinary = 11 ;
  dbMemo = 12 ;
var
  tdfNew: Variant ;
begin
  { If the table exist in the database, Access will generate a runtime error.
    To prevent this we must check for it's existance and if found remove it. }
  if TableExistInMDB(dbs,cTableName) then
    try
      dbs.Execute(' DROP TABLE ' + cTableName) ;
    except
      Result := False ;
      MessageDlg('Failed to remove ' + cTableName + ' table',mtError,[mbOk],0) ;
      exit ;
    end ;

  { Here we create the table definition DAO fashion. You can not do it using
    SQL-92 since several data types are un-supported. }
  try
    tdfNew := dbs.CreateTableDef(cTableName) ;
    tdfNew.Fields.Append( tdfNew.CreateField('ID', dbInteger) ) ;
    tdfNew.Fields.Append( tdfNew.CreateField('Name', dbText) ) ;
    tdfNew.Fields.Append( tdfNew.CreateField('Memo', dbMemo) ) ;
    tdfNew.Fields.Append( tdfNew.CreateField('Picture', dbLongBinary) ) ;
  except
    MessageDlg('Failed creating fields for ' + cTableName,mtError,[mbOk],0) ;
    Result := False ;
    exit ;
  end ;

  { Here we append the table definition to the database }
  try
    dbs.TableDefs.Append( tdfNew ) ;
  except
    ErrorMsg('Failed to append ' + cTableName + ' to database') ;
    Result := False ;
    exit ;
  end ;

  { Create a primary key }
  try
    dbs.Execute('CREATE INDEX PrimaryKey ON ' + cTableName + ' (ID) WITH PRIMARY') ;
  except
    MessageDlg('Failed to create primary key for ' + cTableName,mtError,[mbOk],0) ;
    Result := False ;
    exit ;
  end ;

  { Create a secondary key }
  try
    dbs.Execute('CREATE INDEX Names ON ' + cTableName + ' (NAME)') ;
  except
    MessageDlg('Failed to create secondary key for ' + cTableName,mtError,[mbOk],0) ;
    Result := False ;
    exit ;
  end ;

  { All went fine, so we are out of here. }
  Result := True ;
end ;

procedure TForm1.cmdCreateClick(Sender: TObject);
var
  S: String ;
  i: Integer ;
begin
  if not InitAccess then
  begin
    ErrorMsg('failed to initialize DAO') ;
    exit ;
  end ;

  { Get the current path which is were the MS-Access database will be created.
    The database name will surely need to be changed. }
  GetDir(0,S) ;
  S := S + '\JustMadeMe' ;

  { Create an empty MS-Access database }
  if not CreateMDB(S) then
  begin
    ErrorMsg('Failed to create' + #13 + S + '.mdb') ;
    exit ;
  end ;

  for i := 1 to 3 do
  begin
    { Create one recordset }
    if not CreateRecordSet('Table' + IntToStr(i) ) then
    begin
      MessageDlg('Faile to create recordset',mtError,[mbOk],0) ;
      exit ;
    end ;
  end ;

  TButton(Sender).Caption := 'Done!' ;
  TButton(Sender).Enabled := False ;
  ActiveControl := cmdExit ;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  { Shutdown out connect to MS-Access }
  if not VarIsEmpty(dbs) then
  begin
    try
      dbs.Close ;
      dbEngine := Unassigned ;
    except
    end ;
  end ;
end;

procedure TForm1.cmdExitClick(Sender: TObject);
begin
  Close ;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := '' ;
end;

end.

DFM
object Form1: TForm1
  Left = 297
  Top = 107
  BorderStyle = bsDialog
  Caption = 'Form1'
  ClientHeight = 74
  ClientWidth = 437
  Color = clWhite
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Position = poScreenCenter
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label2: TLabel
    Left = 2
    Top = 9
    Width = 425
    Height = 20
    Caption = 'Demo for creating an MS-Access database and table'
    Color = clWhite
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clGray
    Font.Height = -16
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentColor = False
    ParentFont = False
  end
  object Label1: TLabel
    Left = 3
    Top = 6
    Width = 425
    Height = 20
    Caption = 'Demo for creating an MS-Access database and table'
    Color = clWhite
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlue
    Font.Height = -16
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentColor = False
    ParentFont = False
    Transparent = True
  end
  object cmdCreate: TButton
    Left = 135
    Top = 41
    Width = 75
    Height = 25
    Caption = '&Create'
    TabOrder = 0
    OnClick = cmdCreateClick
  end
  object cmdExit: TButton
    Left = 215
    Top = 41
    Width = 75
    Height = 25
    Caption = 'E&xit'
    TabOrder = 1
    OnClick = cmdExitClick
  end
end
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:zeko
ID: 2659560
Thanks
0
 
LVL 2

Expert Comment

by:gallaghe
ID: 2660802
Your welcome
Kevin
0
 

Author Comment

by:zeko
ID: 2661888
How can I put password on this database ?
0
 
LVL 2

Expert Comment

by:gallaghe
ID: 2664245
Easy, the example below is modified from the prior code.

{ Creates an empty MS-Access database with a password. Note that the password
  is done in the second parameter to CreateDatabase. Also when opening the
  database via automation you must pass in the password as shown here. Opening
  the database via MS-Access invokes a "Login" dialog. }
function TForm1.CreateMDB(cDatabaseName: String): boolean ;
const
  MyPassWord = 'Kevin' ;
  dbLangGeneral = ';LANGID=0x0409;CP=1252;COUNTRY=0;PWD=' + MyPassWord ;
  dbVersion = 32 ;
begin
  if FileExists(cDatabaseName + '.mdb') then
    if not DeleteFile(cDatabaseName + '.mdb') then
    begin
      ErrorMsg('Failed to remove' + #13 + cDatabaseName + '.mdb') ;
      Result := False ;
      exit ;
    end ;

  Workspace := DBEngine.Workspaces[0] ;
  try
    { Create the MDB }
    Workspace.CreateDatabase(cDatabaseName,dbLangGeneral, dbVersion) ;
    dbs := dbEngine.OpenDatabase(cDatabaseName,False,False,'MS Access;PWD=' + MyPassWord) ;
    Result := True ;
  except
    ErrorMsg('Failed to create' + #13 + cDatabaseName + '.mdb') ;
    Result := False  ;
    exit ;
  end ;
end ;

Kevin
0

Featured Post

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
can't find the executable in Simulator 1 111
Create a path if not exists 7 105
firemonkey Android Listview Sort items 7 70
Typecasting TBytes to Integer in Delphi XE8 2 31
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

680 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question