[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 264
  • Last Modified:

Create Access Database in Delphi

How can I create a Access Database in Delphi, by using the ADO / ODBC / DAO tools, without using Microsoft Access
0
flappie
Asked:
flappie
  • 5
  • 5
  • 3
  • +1
1 Solution
 
rwilson032697Commented:
Listening
0
 
flappieAuthor Commented:
That's no answer to my question!!
0
 
flappieAuthor Commented:
I only see a reference to your webpage; that is no solving method, because I can't find here any information about my question
0
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
intheCommented:
Hi,

following is a some  text i found on the matter:
Regards Barry


you need the ODBCCP32.DLL (ODBC Administrator DLL) and
 access to the SQLConfigDataSource(...) function in that DLL.
code below will auto-create BOTH the DSN and the MDB forcibly in the
 current home directory.

 A special note. You *should* ask the ODBC administrator what drivers
 are available and use the returned string. I took a short-cut and hard-
 coded the "Microsoft Access Driver (*.mdb)". That's the reason it
 is assigned to a variable,

 procedure Form1.FormCreate(Sender: TObject);
 var
  pFn: TSQLConfigDataSource;
  hLib: LongWord;
  strDriver: string;
  strHome: string;
  strAttr: string;
  strFile: string;
  fResult: BOOL;
  ModName: array[0..MAX_PATH] of Char;
  iTempVar: integer;
  tstrTables: TStringList;
  dADOCommand1: TdADOCommand;
  Reg: TRegistry;
  srInfo : TSearchRec;
 begin
  fIsMaster := false;
  Windows.GetModuleFileName( HInstance, ModName, SizeOf(ModName) );
  strHome := ModName;
  while ( strHome[length(strHome)] <> '\' ) do
    Delete( strHome, length(strHome), 1 );
  strFile := strHome + 'TOOLTOYS.MDB';
  hLib := LoadLibrary( 'ODBCCP32' );    // load from default path
  if( hLib <> NULL ) then
  begin
    @pFn := GetProcAddress( hLib, 'SQLConfigDataSource' );
    if( @pFn <> nil ) then
    begin
      // force (re-)create DSN
      strDriver := 'Microsoft Access Driver (*.mdb)';
      strAttr := Format( 'DSN=TOOLTIME'+#0+
                          'DBQ=%s'+#0+
                          'Exclusive=1'+#0+
                          'Description=Tooltime Toys'+#0+#0,
                          [strFile] );
      fResult := pFn( 0, ODBC_ADD_SYS_DSN, @strDriver[1], @strAttr[1] );
      if( fResult = false ) then ShowMessage( 'Create DSN (Datasource) failed!' );

      // test/create MDB file associated with DSN
      if( FindFirst( strFile, 0, srInfo ) <> 0 ) then
      begin
        strDriver := 'Microsoft Access Driver (*.mdb)';
        strAttr := Format( 'DSN=TOOLTIME'+#0+
                            'DBQ=%s'+#0+
                            'Exclusive=1'+#0+
                            'Description=Tooltime Toys'+#0+
                            'CREATE_DB="%s"'#0+#0,
                            [strFile,strFile] );
        fResult := pFn( 0, ODBC_ADD_SYS_DSN, @strDriver[1],
@strAttr[1] );
        if( fResult = false ) then ShowMessage( 'Create MDB (Database
file)
 failed!' );
      end;
      FindClose( srInfo );

 (* rest missing, do what you have to for the rest of your form's
creation *)

 end;
0
 
flappieAuthor Commented:
If I use your proposal, the program does not recognize TSQLConfigDatasource. The program needs therefore the ODBCcp32.dll program. But I can not load this as an import library. How can I use this library such that the program works??
0
 
intheCommented:
sorry you'll also need to declare that first :

function SQLConfigDataSource(Hwnd:THandle; State:Byte; Driver:PChar;Attributes:PChar): Boolean; stdcall; external 'ODBCCP32.DLL' index 4;
0
 
wilbrownCommented:
Where in the source code is SQLConfigDataSource declared?
In other words, how is it declared?
0
 
intheCommented:
i need to find exact article so i can see as i only copied the code roughly and i cant remember properly how it was all set out.

hopefully back later with tested example unit  ;-)
0
 
wilbrownCommented:


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, StdCtrls, F_Access, Animate, GIFCtrl, Registry;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure CreateDatabase(Sender: TObject;var Alias,Desc,DBName:String);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;

implementation
{$R *.DFM}
    function SQLConfigDataSource(HWnd:THandle;State:Byte;
             Driver:PChar;Attributes:PChar):Boolean;Stdcall;
             External 'ODBCCP32.DLL' index 4;

type
   TSQLConfigDataSource = function (HWnd:THandle;State:Byte;
             Driver:PChar;Attributes:PChar):Boolean; stdcall;

procedure TForm1.CreateDatabase(Sender: TObject;var Alias,Desc,DBName:String);
var
 NewName:string;
 pFn : TSQLConfigDataSource;
 hLib: LongWord;
 strDriver: string;
 strHome : string;
 strattr : string;
 strFile : string;
 fResult : BOOL;
 ModName: array[0..MAX_PATH] of Char;
 srInfo : TSearchRec;
 begin
  if pos('.',DBname) = 0 then NewName := DBname + '.mdb';
  if FileExists(NewName) then
   begin
    MessageDlg('Database exists',mtError,[mbOK],0);
    exit;
   end;
   Windows.GetModuleFileName(HInstance,ModName, SizeOf(ModName));
   strHome := ModName;
   while (strHome[length(strHome)] <> '\') do
    Delete(strHome, length(strHome),1);
    strFile := strHome + NewName;
    hLib := LoadLibrary('ODBCCP32');
    if(hLib <> NULL) then
     begin
      @pFn := GetProcAddress(hLib, 'SQLConfigDataSource');
      if (@pFn <> nil) then
      begin
       strDriver := 'Microsoft Access Driver (*.mdb)';
       strAttr := Format('DSN='+Alias+#0+'DBQ=%s'+#0+'Exclusive=1'+#0+
                         'Description='+Desc+#0+#0,[strFile]);
       fResult := pFn(0,1, @strDriver[1], @strAttr[1]);
       if (fResult = false) then ShowMessage('Create DSN (Datasource) failed!');
       if (FindFirst(strFile, 0, srInfo) <> 0) then
      begin
       strDriver := 'Microsoft Access Driver (*.mdb)';
       strAttr := Format('DSN='+Alias+#0+'DBQ=%s'+#0+'Exclusive=1'+#0+
                         'Description='+Desc+#0+
                         'CREATE_DB="%s"'#0+#0,[strFile,strFile]);
       fResult := pFn(0,1, @strDriver[1], @strAttr[1]);
    if (fResult = false) then ShowMessage('Create MDB (Database file) failed!');
      end;
          FindClose(srInfo);
  end;
 end;
end;


procedure TForm1.Button1Click(Sender: TObject);
 var
  Alias,Desc,Name:string;

begin
 Alias := Edit1.text;
 Desc := Edit2.text;
 Name := Edit3.text;
 CreateDatabase(self,Alias,Desc,Name);
end;

end.
 


procedure TForm1.Button1Click(Sender: TObject);
 var
  Alias,Desc,Name:string;

begin
 Name := Edit1.text;

 CreateDatabase(self,Alias,Desc,Name);
end;

end.




Here is the Form:

object Form1: TForm1
  Left = 511
  Top = 198
  Width = 329
  Height = 232
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 96
    Top = 96
    Width = 163
    Height = 13
    Caption = 'Choose a name for database'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label2: TLabel
    Left = 96
    Top = 48
    Width = 120
    Height = 13
    Caption = 'Choose a description'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label3: TLabel
    Left = 96
    Top = 0
    Width = 92
    Height = 13
    Caption = 'Choose an Alias'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Button1: TButton
    Left = 96
    Top = 144
    Width = 113
    Height = 49
    Caption = 'Create Database'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Edit1: TEdit
    Left = 96
    Top = 16
    Width = 113
    Height = 21
    TabOrder = 1
    Text = 'Test'
  end
  object Edit2: TEdit
    Left = 96
    Top = 64
    Width = 121
    Height = 21
    TabOrder = 2
    Text = 'Test'
  end
  object Edit3: TEdit
    Left = 96
    Top = 112
    Width = 121
    Height = 21
    TabOrder = 3
    Text = 'Test'
  end
end
 
0
 
wilbrownCommented:
After studing the matter, I have come up with a modification of the above program that will created an
empty MSAccess database ready to populate with tables. Here are both the program and the Form:


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure CreateDatabase(Sender: TObject;var Alias,Desc,DBName:String);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;

implementation
{$R *.DFM}
    function SQLConfigDataSource(HWnd:THandle;State:Byte;
             Driver:PChar;Attributes:PChar):Boolean;Stdcall;External 'ODBCCP32.DLL' index 4;

type
   TSQLConfigDataSource = function (HWnd:THandle;State:Byte;Driver:PChar;Attributes:PChar):Boolean; stdcall;

procedure TForm1.CreateDatabase(Sender: TObject;var Alias,Desc,DBName:String);
var
 NewName:string;
 pFn : TSQLConfigDataSource;
 hLib: LongWord;
 strDriver: string;
 strHome : string;
 strattr : string;
 strFile : string;
 fResult : BOOL;
 ModName: array[0..MAX_PATH] of Char;
 srInfo : TSearchRec;
 begin
  if pos('.',DBname) = 0 then NewName := DBname + '.mdb';
  if FileExists(NewName) then
   begin
    MessageDlg('Database exists',mtError,[mbOK],0);
    exit;
   end;
   Windows.GetModuleFileName(HInstance,ModName, SizeOf(ModName));
   strHome := ModName;
   while (strHome[length(strHome)] <> '\') do
    Delete(strHome, length(strHome),1);
    strFile := strHome + NewName;
    hLib := LoadLibrary('ODBCCP32');
    if(hLib <> NULL) then
     begin
      @pFn := GetProcAddress(hLib, 'SQLConfigDataSource');
      if (@pFn <> nil) then
      begin
       strDriver := 'Microsoft Access Driver (*.mdb)';
       strAttr := Format('DSN='+Alias+#0+'DBQ=%s'+#0+'Exclusive=1'+#0+
                         'Description='+Desc+#0+#0,[strFile]);
       fResult := pFn(0,1, @strDriver[1], @strAttr[1]);
       if (fResult = false) then ShowMessage('Create DSN (Datasource) failed!');
       if (FindFirst(strFile, 0, srInfo) <> 0) then
      begin
       strDriver := 'Microsoft Access Driver (*.mdb)';
       strAttr := Format('DSN='+Alias+#0+'DBQ=%s'+#0+'Exclusive=1'+#0+
                         'Description='+Desc+#0+
                         'CREATE_DB="%s"'#0+#0,[strFile,strFile]);
       fResult := pFn(0,1, @strDriver[1], @strAttr[1]);
    if (fResult = false) then ShowMessage('Create MDB (Database file) failed!');
      end;
          FindClose(srInfo);
  end;
 end;
end;


procedure TForm1.Button1Click(Sender: TObject);
 var
  Alias,Desc,Name:string;

begin
 Alias := Edit1.text;
 Desc := Edit2.text;
 Name := Edit3.text;
 CreateDatabase(self,Alias,Desc,Name);
end;
end.
 



Here is the Form:

object Form1: TForm1
  Left = 511
  Top = 198
  Width = 329
  Height = 232
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 96
    Top = 96
    Width = 163
    Height = 13
    Caption = 'Choose a name for database'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label2: TLabel
    Left = 96
    Top = 48
    Width = 120
    Height = 13
    Caption = 'Choose a description'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label3: TLabel
    Left = 96
    Top = 0
    Width = 92
    Height = 13
    Caption = 'Choose an Alias'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Button1: TButton
    Left = 96
    Top = 144
    Width = 113
    Height = 49
    Caption = 'Create Database'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Edit1: TEdit
    Left = 96
    Top = 16
    Width = 113
    Height = 21
    TabOrder = 1
    Text = 'Test'
  end
  object Edit2: TEdit
    Left = 96
    Top = 64
    Width = 121
    Height = 21
    TabOrder = 2
    Text = 'Test'
  end
  object Edit3: TEdit
    Left = 96
    Top = 112
    Width = 121
    Height = 21
    TabOrder = 3
    Text = 'Test'
  end
end
 
0
 
intheCommented:
flappie
reject my proposal & give the points to wilbrown  :-)
that is excellent example ,i tried several times and coulnt get it right so am glad ot see a working one.
cheers
0
 
rwilson032697Commented:
Very recently I saw (on EE I thought) a very elegant example of creating an Access DB via ADO. It was about 6 lines of code - sadly I didn't save it in my PAQs!

Cheers,

Raymond.
0
 
flappieAuthor Commented:
The proposal of WilBrown works. How do I give him the credit points? I mean, if I reject, I can give them to him, or is the question then open to everyone??
0
 
flappieAuthor Commented:
The proposal of WilBrown works. How do I give him the credit points? I mean, if I reject, I can give them to him, or is the question then open to everyone??
0
 
intheCommented:
if you reject then wilbrown can re-post a comment as answer.
0

Featured Post

The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

  • 5
  • 5
  • 3
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now