Solved

Access database

Posted on 2000-03-16
7
200 Views
Last Modified: 2010-04-04
How can I create Access database with
two tables ???
0
Comment
Question by:zeko
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Technology Partners: 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

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
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…
Are you ready to implement Active Directory best practices without reading 300+ pages? You're in luck. In this webinar hosted by Skyport Systems, you gain insight into Microsoft's latest comprehensive guide, with tips on the best and easiest way…

737 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