whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1547)

Database (90)
Files (137)
Forms (107)
Graphic (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

29 Visitors Online


 
...write to an Access DB using ADO / SQL
Autor: Michael Casse
[ Print tip ]  

Tip Rating (20):  
     


// Read an MS-ACCESS Database using ADO
// Verify if it is an ACCESS MDB File
// Write a Record to MS-ACCESS Database
// Components Needed on the Application Form are:-
//    TADOtable,TDataSource,TOpenDialog,TDBGrid,
//    TBitBtn,TTimer,TEditTextBox
// Date : 22/01/2002
// Author: Michael Casse.

program ADOdemo;

uses
  
Forms,
  uMain in 'uMain.pas' {frmMain};

{$R *.RES}

begin
  
Application.Initialize;
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run;
end.
///////////////////////////////////////////////////////////////////
unit uMain;

interface

uses
  
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, ADODB, Grids, DBGrids, ExtCtrls, DBCtrls, StdCtrls, Buttons,
  ComObj;

type
  
TfrmMain = class(TForm)
    DBGridUsers: TDBGrid;
    BitBtnClose: TBitBtn;
    DSource1: TDataSource;
    EditTextBox: TEdit;
    BitBtnAdd: TBitBtn;
    TUsers: TADOTable;
    BitBtnRefresh: TBitBtn;
    Timer1: TTimer;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ConnectToAccessDB(lDBPathName, lsDBPassword: string);
    procedure ConnectToMSAccessDB(lsDBName, lsDBPassword: string);
    procedure AddRecordToMSAccessDB;
    function CheckIfAccessDB(lDBPathName: string): Boolean;
    function GetDBPath(lsDBName: string): string;
    procedure BitBtnAddClick(Sender: TObject);
    procedure BitBtnRefreshClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    function GetADOVersion: Double;
    procedure Button1Click(Sender: TObject);
  private
    
{ Private declarations }
  
public
    
{ Public declarations }
  
end;

var
  
frmMain: TfrmMain;
  Global_DBConnection_String: string;
const
  
ERRORMESSAGE_1 = 'No Database Selected';
  ERRORMESSAGE_2 = 'Invalid Access Database';

implementation

{$R *.DFM}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  
ConnectToMSAccessDB('ADODemo.MDB', '123'); // DBName,DBPassword
end;

procedure TfrmMain.ConnectToMSAccessDB(lsDBName, lsDBPassword: string);
var
  
lDBpathName: string;
begin
  
lDBpathName := GetDBPath(lsDBName);
  if (Trim(lDBPathName) <> '') then
  begin
    if 
CheckIfAccessDB(lDBPathName) then
      
ConnectToAccessDB(lDBPathName, lsDBPassword);
  end
  else
    
MessageDlg(ERRORMESSAGE_1, mtInformation, [mbOK], 0);
end;

function TfrmMain.GetDBPath(lsDBName: string): string;
var
  
lOpenDialog: TOpenDialog;
begin
  
lOpenDialog := TOpenDialog.Create(nil);
  if FileExists(ExtractFileDir(Application.ExeName) + '\' + lsDBName) then
    
Result := ExtractFileDir(Application.ExeName) + '\' + lsDBName
  else
  begin
    
lOpenDialog.Filter := 'MS Access DB|' + lsDBName;
    if lOpenDialog.Execute then
      
Result := lOpenDialog.FileName;
  end;
end;

procedure TfrmMain.ConnectToAccessDB(lDBPathName, lsDBPassword: string);
begin
  
Global_DBConnection_String :=
    'Provider=Microsoft.Jet.OLEDB.4.0;' +
    'Data Source=' + lDBPathName + ';' +
    'Persist Security Info=False;' +
    'Jet OLEDB:Database Password=' + lsDBPassword;

  with TUsers do
  begin
    
ConnectionString := Global_DBConnection_String;
    TableName        := 'Users';
    Active           := True;
  end;
end;

// Check if it is a valid ACCESS DB File Before opening it.

function TfrmMain.CheckIfAccessDB(lDBPathName: string): Boolean;
var
  
UnTypedFile: file of Byte;
  Buffer: array[0..19] of Byte;
  NumRecsRead: Integer;
  i: Integer;
  MyString: string;
begin
  
AssignFile(UnTypedFile, lDBPathName);
  reset(UnTypedFile,1);
  BlockRead(UnTypedFile, Buffer, 19, NumRecsRead);
  CloseFile(UnTypedFile);
  for i := 1 to 19 do MyString := MyString + Trim(Chr(Ord(Buffer[i])));
  Result := False;
  if Mystring = 'StandardJetDB' then
    
Result := True;
  if Result = False then
    
MessageDlg(ERRORMESSAGE_2, mtInformation, [mbOK], 0);
end;

procedure TfrmMain.BitBtnAddClick(Sender: TObject);
begin
  
AddRecordToMSAccessDB;
end;

procedure TfrmMain.AddRecordToMSAccessDB;
var
  
lADOQuery: TADOQuery;
  lUniqueNumber: Integer;
begin
  if 
Trim(EditTextBox.Text) <> '' then
  begin
    
lADOQuery := TADOQuery.Create(nil);
    with lADOQuery do
    begin
      
ConnectionString := Global_DBConnection_String;
      SQL.Text         :=
        'SELECT Number from Users';
      Open;
      Last;
      // Generate Unique Number (AutoNumber in Access)
      
lUniqueNumber := 1 + StrToInt(FieldByName('Number').AsString);
      Close;
      // Insert Record into MSAccess DB using SQL
      
SQL.Text :=
        'INSERT INTO Users Values (' +
        IntToStr(lUniqueNumber) + ',' +
        QuotedStr(UpperCase(EditTextBox.Text)) + ',' +
        QuotedStr(IntToStr(lUniqueNumber)) + ')';
      ExecSQL;
      Close;
      // This Refreshes the Grid Automatically
      
Timer1.Interval := 5000;
      Timer1.Enabled  := True;
    end;
  end;
end;

procedure TfrmMain.BitBtnRefreshClick(Sender: TObject);
begin
  
Tusers.Active := False;
  Tusers.Active := True;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
  
Tusers.Active  := False;
  Tusers.Active  := True;
  Timer1.Enabled := False;
end;

function TfrmMain.GetADOVersion: Double;
var
  
ADO: OLEVariant;
begin
  try
    
ADO    := CreateOLEObject('adodb.connection');
    Result := StrToFloat(ADO.Version);
    ADO    := Null;
  except
    
Result := 0.0;
  end;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
  
ShowMessage(Format('ADO Version = %n', [GetADOVersion]));
end;

end.


 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners