Solved

Access database

Posted on 2000-03-16
7
189 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Best Firemonkey component pack 1 87
find a node in VST 2 63
How to build JSON File in Delphi 6 3 13
update joined tables 2 31
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, just open a new email message. In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
With the power of JIRA, there's an unlimited number of ways you can customize it, use it and benefit from it. With that in mind, there's bound to be things that I wasn't able to cover in this course. With this summary we'll look at some places to go…

920 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

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now