Записываем в 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.

Добавить комментарий