D E L P H I 's Search Engine : FunnyLogo.info : Personal Search Engine Maker of Style Yahoo

 

Web ImagesVideoNewsMapsBooks More»
 
 Advanced Search
 Preferences
 Language Tools


BookMark     Create your own Search Engine Now


FunnyLogo is not affiliated with Google Inc.
Trademarks remain trademarks of their respective companies.
© 2007 FunnyLogo

Sedo - Buy and Sell Domain Names and Websites project info: funnylogo.info Statistics for project funnylogo.info etracker® web controlling instead of log file analysis

Rabu, 07 November 2007

WRITE TO AN ACCESS DB USING ADO / SQL

// ******************************************************************
// WRITE TO AN ACCESS DB USING ADO / SQL
// Category : ADO
// Author : Michael Casse
// Author Email : michaelc@netspace.net.au
// Author Web :
// Tips Website : Swiss Delphi Center
// Tips Website URL: http://www.swissdelphicenter.ch
// ******************************************************************

// 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.