Tips dan Triks Tutorial Delphi

Tips dan Triks Tutorial Delphi

Lengkap, mantaps dan bermanfaat, berisi tips dan triks dari berbagai situs delphi di jagad web,

Download disini Gratis

Download Arsip Majalah Neotek

Download Arsip Majalah Neotek

Banyak Loh Tutorial didalamnya dari yang dasar sampai yang petualang

Download Disini

Free Video Tutorial SQL SERVER dan ASP.Net

Bagi rekan-rekan yang mau Video Tutorial SQL Server dan ASP.Net

l

Lumayan buat panduan
Download Disini

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.

RETRIEVE ALL DATABASE TABLES WITH ADO

// ******************************************************************
// RETRIEVE ALL DATABASE TABLES WITH ADO
// Category : ADO
// Author : Carlo Pasolini, Riccione
// Author Email : ccpasolini@libero.it
// Author Web :
// Tips Website : Swiss Delphi Center
// Tips Website URL: http://www.swissdelphicenter.ch
// ******************************************************************

//How to retrieve all database tables with ADO

unit dbTables;

interface

uses ADODb;

type
TTableType = (ttTable, ttView, ttSynonym, ttSystemTable, ttAccessTable);

type
TTableTypes = set of TTableType;

type
TTableItem = record
ItemName: string;
ItemType: string;
end;

type
TTableItems = array of TTableItem;

function addFilter(string1, string2: string): string;
function ADODbTables(ADOConnection: TADOConnection; types: TTableTypes): TTableItems;

implementation

function addFilter(string1, string2: string): string;
begin
if string1 <> ” then
Result := string1 + ‘ or ‘ + string2
else
Result := string2;
end;

function ADODbTables(ADOConnection: TADOConnection; types: TTableTypes): TTableItems;
var
ADODataSet: TADODataSet;
i: integer;
begin
ADODataSet := TADODataSet.Create(nil);
ADODataSet.Connection := ADOConnection;
ADOConnection.OpenSchema(siTables, EmptyParam, EmptyParam, ADODataSet);

if (ttTable in types) then
ADODataSet.Filter := addFilter(ADODataSet.Filter, ‘(TABLE_TYPE = ”TABLE”)’);

if (ttView in types) then
ADODataSet.Filter := addFilter(ADODataSet.Filter, ‘(TABLE_TYPE = ”VIEW”)’);

if (ttSynonym in types) then
ADODataSet.Filter := addFilter(ADODataSet.Filter, ‘(TABLE_TYPE = ”SYNONYM”)’);

if (ttSystemTable in types) then
ADODataSet.Filter := addFilter(ADODataSet.Filter, ‘(TABLE_TYPE = ”SYSTEM TABLE”)’);

if (ttAccessTable in types) then
ADODataSet.Filter := addFilter(ADODataSet.Filter, ‘(TABLE_TYPE = ”ACCESS TABLE”)’);

ADODataSet.Filtered := True;

SetLength(Result, ADODataSet.RecordCount);

i := 0;
with ADODataSet do
begin
First;
while not EOF do
begin
with Result[i] do
begin
ItemName := FieldByName(‘TABLE_NAME’).AsString;
ItemType := FieldByName(‘TABLE_TYPE’).AsString;
end;
Inc(i);
Next;
end;
end;

ADODataSet.Free;
end;

end.

{
Example: create a new project and add a TADOConnection (ADOConnection1),
a TButton (Button1) and a TMemo (Memo1); assign a ConnectionString to the
TADOConnection component and set “ADOConnection1.Active := True”
}

procedure TForm1.Button1Click(Sender: TObject);
var
output: ttableitems;
i: integer;
begin
output := ADODbTables(ADOConnection1, [ttTable, ttView, ttSynonym]);
// output := ADODbTables(ADOConnection1, [ttSystemTable, ttAccessTable]);
for i := Low(output) to High(output) do
begin
Memo1.Lines.Add(output[i].ItemName + ‘—’ + output[i].ItemType);
end;
output := nil;
end;

READ THE INSTALLED ADO VERSION

// ******************************************************************
// READ THE INSTALLED ADO VERSION
// Category : ADO
// Author : m3Rlin
// Author Email : m3rlin@realmind.us
// Author Web : http://www.m3Rlin.prv.pl/
// Tips Website : Merlin’s Delphi Forge
// Tips Website URL: http://www.realmind.us/sites/mdf/html/modules.php?name=FAQ
// ******************************************************************

{
With different versions of MDAC available it is sometimes good to check whether
the latest version is installed to make sure everything works fine.
The following function returns the installed ADO version.
}

uses
ComObj;
function GetADOVersion: Double;
var
ADO: OLEVariant;
begin
try
ADO := CreateOLEObject(‘adodb.connection’);
Result := StrToFloat(ADO.Version);
ADO := null;
except
Result := 0.0;
end;
end;

READ AN ACCESS DB USING ADO

// ******************************************************************
// READ AN ACCESS DB USING ADO
// 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
// ******************************************************************

Author:

// Read an MS-ACCESS Database (any versions) using ADO
// Verify if it is an ACCESS MDB
// Components Needed on the Application Form are:
// TADOtable,TDataSource,TOpenDialog,TDBGrid,TBitBtn.
// Date : 14/01/2002
// Author: Michael Casse.

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.

MAKE AN ADODB CONNECTION USING OLE-AUTOMATION

// ******************************************************************
// MAKE AN ADODB CONNECTION USING OLE-AUTOMATION
// Category : ADO
// Author : Daniel Henrique M. de Carvalho
// Author Email : progtecnic@hotmail.com
// Author Web :
// Tips Website : Swiss Delphi Center
// Tips Website URL: http://www.swissdelphicenter.ch
// ******************************************************************

{…}
uses
ComObj;
{…}

function OpenConnection(ConnectionString: AnsiString): integer;
var
ADODBConnection: OleVariant;
begin
ADODBConnection := CreateOleObject(‘ADODB.Connection’);
ADODBConnection.CursorLocation := 3; // User client
ADODBConnection.ConnectionString := ConnectionString;
Result := 0;
try
ADODBConnection.Open;
except
Result := -1;
end;
end;

function DataBaseConnection_Test(bMessage: boolean): AnsiString;
var
asTimeout,
asUserName,
asPassword,
asDataSource,
ConnectionString: AnsiString;
iReturn: Integer;
OldCursor: TCursor;
begin
OldCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
asTimeout := ‘150′;
asUserName := ‘NT_Server’;
asPassword := ‘SA’;
asDataSource := ‘SQL Server – My DataBase’;

ConnectionString := ‘Data Source = ‘ + asDataSource +
‘User ID = ‘ + asUserName +
‘Password = ‘ + asPassword +
‘Mode = Read|Write;Connect Timeout = ‘ + asTimeout;
try
iReturn := OpenConnection(ConnectionString);

if (bMessage) then
begin
if (iReturn = 0) then
Application.MessageBox(‘Connection OK!’, ‘Information’, MB_OK)
else if (iReturn = -1) then
Application.MessageBox(‘Connection Error!’, ‘Error’, MB_ICONERROR + MB_OK);
end;

if (iReturn = 0) then
Result := ConnectionString
else if (iReturn = -1) then
Result := ”;
finally
Screen.Cursor := OldCursor;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
DataBaseConnection_Test(true);
end;

MS-SQL : CONNECTION IS IN USE BY ANOTHER STATEMENT

// ******************************************************************
// MS-SQL : CONNECTION IS IN USE BY ANOTHER STATEMENT
// Category : ADO
// Author : DelphiFAQ.com
// Author Email : tips@delphifaq.com
// Author Web : http://www.delphifaq.com
// Tips Website : Delphi FAQ
// Tips Website URL: http://www.delphifaq.com
// ******************************************************************

{
When porting a larger database application (130k LOC) that worked fine with
Oracle and InterBase to MS-SQL (6.5), I frequently got the error message
‘connection is in use by another statement’.

At first, creating a new TDatabase for each TTable/ TQuery seemed to be
necessary.

Then I found what was ‘wrong’ (not really wrong.. :-)

To speed up some of my queries, I had set the property Unidirectional to true.
Delphi creates for such queries only one cursor (versus two for bidirectional
queries or TTables). After removing the assignments of Unidirectional := true
the error message disappeared and everything worked fine.

The following code resulted in the exception ‘connection is in use by another
statement’:
}

// dataBaseNameS : string is the name of the alias (MS-SQL 6.5)
begin
Query1 := TQuery.Create (Application);
With Query1 do
begin
DatabaseName := dataBaseNameS;
SQL.Text := ‘SELECT * FROM ABLESTOP’;
// the exception disappears if the following is removed
Unidirectional := True;
Open;
end;
ShowMessage (‘ok’)

Table1 := TTable.Create (Self);
With Table1 do
begin
DatabaseName := dataBaseNameS;
TableName := ‘COMPONENT_PLAN’;
UpdateMode := upWhereKeyOnly;
Open
end;

Table1.Insert;
Table1.FieldByName (‘PARTNO’).AsString := IntToStr (GetTickCount);
Table1.FieldByName (‘ID’).AsString := ‘WWxx’;
Table1.FieldByName (‘VERSION’).AsInteger := 1;
// the exception will occurr in the next statement:
// “Connection is in use by another statement”
Table1.Post;
end;

DETECT, WHICH VERSION OF ADO IS INSTALLED

// ******************************************************************
// DETECT, WHICH VERSION OF ADO IS INSTALLED
// Category : ADO
// Author : Simon Carter
// Author Email : simon.carter@orcka.com
// Author Web : http://www.orcka.com
// Tips Website : Swiss Delphi Center
// Tips Website URL: http://www.swissdelphicenter.ch
// ******************************************************************

{
With different versions of MDAC available it is sometimes useful to know that your a
application won’t fail because a user hasn’t got the latest version installed.
The following function returns the ADO version installed, you need to place ComObj in
the uses clause to use this function.
}

function GetADOVersion: Double;
var
ADO: Variant;
begin
try
ADO := CreateOLEObject(‘adodb.connection’);
Result := StrToFloat(ADO.Version);
ADO := Null;
except
Result := 0.0;
end;
end;

// To use this function try something like:

procedure TForm1.Button1Click(Sender: TObject);
const
ADOVersionNeeded = 2.5;
begin
if GetADOVersion < ADOVersionNeeded then
ShowMessage(‘Need to install MDAC version 2.7′)
else
ShowMessage(Format(‘ADO Version %n, is OK’, [GetADOVersion]));
end;