Title: write to an Access DB using ADO / SQL
// 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.