Recent Posts
Selamat datang di Coding Delphi Land Weblog kumpulan source code pemogram delphi
(Bukan maksud untuk menggurui tetapi marilah kita berbagi ilmu tuk perkembangan kemajuan teknologi kita
Selasa, 17 November 2009
Read Acces Using Ado
unit uMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBTables, ADODB, Grids, DBGrids, ExtCtrls, DBCtrls, StdCtrls, Buttons;
type
TfrmMain = class(TForm)
DSUsers: TDataSource;
DBGridUsers: TDBGrid;
BitBtn1: TBitBtn;
OpenDialog1: TOpenDialog;
TUsers: TADOTable;
procedure FormCreate(Sender: TObject);
procedure ValidateAccessDB;
function CheckIfAccessDB(lDBPathName: string): boolean;
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
const
DBNAME = 'ADODemo.MDB';
DBPASSWORD = '123'; // Access DB Password Protected
implementation
{$R *.DFM}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
validateAccessDB;
end;
procedure TfrmMain.ValidateAccessDB;
var
lDBpathName : String;
lDBcheck : boolean;
begin
if FileExists(ExtractFileDir(Application.ExeName) + '\' + DBNAME) then
lDBPathName := ExtractFileDir(Application.ExeName) + '\' + DBNAME
else if OpenDialog1.Execute then
// Set the OpenDialog Filter for ADOdemo.mdb only
lDBPathName := OpenDialog1.FileName;
lDBCheck := False;
if Trim(lDBPathName) <> '' then
lDBCheck := CheckIfAccessDB(lDBPathName);
if lDBCheck = True then
begin
// ADO Connection String to the MS-ACCESS DB
TUsers.ConnectionString :=
'Provider=Microsoft.Jet.OLEDB.4.0;' +
'Data Source=' + lDBPathName + ';' +
'Persist Security Info=False;' +
'Jet OLEDB:Database Password=' + DBPASSWORD;
TUsers.TableName := 'Users';
TUsers.Active := True;
end
else
frmMain.Free;
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);
BlockRead(UnTypedFile, Buffer, High(Buffer), NumRecsRead);
CloseFile(UnTypedFile);
for i := 1 to High(Buffer) do
MyString := MyString + Trim(Chr(Ord(Buffer[i])));
Result := False;
if Mystring = 'StandardJetDB' then
Result := True;
if Result = False then
MessageDlg('Invalid Access Database', mtInformation, [mbOK], 0);
end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBTables, ADODB, Grids, DBGrids, ExtCtrls, DBCtrls, StdCtrls, Buttons;
type
TfrmMain = class(TForm)
DSUsers: TDataSource;
DBGridUsers: TDBGrid;
BitBtn1: TBitBtn;
OpenDialog1: TOpenDialog;
TUsers: TADOTable;
procedure FormCreate(Sender: TObject);
procedure ValidateAccessDB;
function CheckIfAccessDB(lDBPathName: string): boolean;
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
const
DBNAME = 'ADODemo.MDB';
DBPASSWORD = '123'; // Access DB Password Protected
implementation
{$R *.DFM}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
validateAccessDB;
end;
procedure TfrmMain.ValidateAccessDB;
var
lDBpathName : String;
lDBcheck : boolean;
begin
if FileExists(ExtractFileDir(Application.ExeName) + '\' + DBNAME) then
lDBPathName := ExtractFileDir(Application.ExeName) + '\' + DBNAME
else if OpenDialog1.Execute then
// Set the OpenDialog Filter for ADOdemo.mdb only
lDBPathName := OpenDialog1.FileName;
lDBCheck := False;
if Trim(lDBPathName) <> '' then
lDBCheck := CheckIfAccessDB(lDBPathName);
if lDBCheck = True then
begin
// ADO Connection String to the MS-ACCESS DB
TUsers.ConnectionString :=
'Provider=Microsoft.Jet.OLEDB.4.0;' +
'Data Source=' + lDBPathName + ';' +
'Persist Security Info=False;' +
'Jet OLEDB:Database Password=' + DBPASSWORD;
TUsers.TableName := 'Users';
TUsers.Active := True;
end
else
frmMain.Free;
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);
BlockRead(UnTypedFile, Buffer, High(Buffer), NumRecsRead);
CloseFile(UnTypedFile);
for i := 1 to High(Buffer) do
MyString := MyString + Trim(Chr(Ord(Buffer[i])));
Result := False;
if Mystring = 'StandardJetDB' then
Result := True;
if Result = False then
MessageDlg('Invalid Access Database', mtInformation, [mbOK], 0);
end;
end.
1 komentar:
dfgdfgdfg
Posting Komentar