Записываем в Access используя ADO

// Читаем Access`овскую базу используя ADO 
// Проверяе являеться ли файл .mdb Access
// Записываем запись в базу 
// Нужны компаненты- 
// TADOtable,TDataSource,TOpenDialog,TDBGrid, 
// TBitBtn,TTimer,TEditTextBox 
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.