Solved

Access database

Posted on 2000-03-16
7
188 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
Comment Utility
from Delphi or within Access?
0
 

Author Comment

by:zeko
Comment Utility
FROM Delphi 5.0
0
 
LVL 2

Accepted Solution

by:
gallaghe earned 50 total points
Comment Utility
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
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 

Author Comment

by:zeko
Comment Utility
Thanks
0
 
LVL 2

Expert Comment

by:gallaghe
Comment Utility
Your welcome
Kevin
0
 

Author Comment

by:zeko
Comment Utility
How can I put password on this database ?
0
 
LVL 2

Expert Comment

by:gallaghe
Comment Utility
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

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
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 this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

744 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

13 Experts available now in Live!

Get 1:1 Help Now