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



Опубликовал admin
7 Ноя, Вторник 2006г.



Программирование для чайников.