?
Solved

Access database

Posted on 2000-03-16
7
Medium Priority
?
207 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 200 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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

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

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!

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…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…
Suggested Courses
Course of the Month11 days, 20 hours left to enroll

752 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