Programlama yapalım ve Öğrenelim.

neoturk: ...Read an access db using ado ?...

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

Delphi - .....................................

neoturk: ...Read an access db using ado ?...

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

Delphi - .....................................

neoturk: ...Duplicate a ttable ?...

{

As we know, Paradox Tables consist in a table file and some corresponding index files

there are many way to copy them:

1. Using TBatchMover (at DataAccess Pallete) with Mode : BatCopy

But you can't copy the tables corresponding index files, TBatchMove just

copies the structure and data.

2. Using FileCopy

But you can't copy the tables corresponding index files automatically,

you should define each files

.. and many more

The Simple way is:

Put two TTables on your form, name it as tbSource and tbTarget.

Then, put this procedure under implementation area

}

type

TForm1 = class(TForm)

tbSource: TTable;

tbTarget: TTable;

// ...

end;

implementation

procedure TForm1.Button1Click(Sender: TObject);

begin

tbSource.TableName := 'Source.DB'; // The name of your tables which you want to copy from

tbTarget.TableName := 'Target.DB'; // The name of your tables which you will to copy to

// You Can set the tbSource.DataBaseName to an existing path/Alias

// where you store your DB

// You Can set the tbTarget.DataBaseName to an existing path/Alias

// where you want to store the duplicate DB

tbSource.StoreDefs := True;

tbTarget.StoreDefs := True;

tbSource.FieldDefs.Update;

tbSource.IndexDefs.Update;

tbTarget.FieldDefs := tbSource.FieldDefs;

tbTarget.IndexDefs := tbSource.IndexDefs;

tbTarget.CreateTable;

//Actually you can set these code up to only 5 lines

end;

End.

Delphi - .....................................

neoturk: ...Duplicate a ttable ?...

{

As we know, Paradox Tables consist in a table file and some corresponding index files

there are many way to copy them:

1. Using TBatchMover (at DataAccess Pallete) with Mode : BatCopy

But you can't copy the tables corresponding index files, TBatchMove just

copies the structure and data.

2. Using FileCopy

But you can't copy the tables corresponding index files automatically,

you should define each files

.. and many more

The Simple way is:

Put two TTables on your form, name it as tbSource and tbTarget.

Then, put this procedure under implementation area

}

type

TForm1 = class(TForm)

tbSource: TTable;

tbTarget: TTable;

// ...

end;

implementation

procedure TForm1.Button1Click(Sender: TObject);

begin

tbSource.TableName := 'Source.DB'; // The name of your tables which you want to copy from

tbTarget.TableName := 'Target.DB'; // The name of your tables which you will to copy to

// You Can set the tbSource.DataBaseName to an existing path/Alias

// where you store your DB

// You Can set the tbTarget.DataBaseName to an existing path/Alias

// where you want to store the duplicate DB

tbSource.StoreDefs := True;

tbTarget.StoreDefs := True;

tbSource.FieldDefs.Update;

tbSource.IndexDefs.Update;

tbTarget.FieldDefs := tbSource.FieldDefs;

tbTarget.IndexDefs := tbSource.IndexDefs;

tbTarget.CreateTable;

//Actually you can set these code up to only 5 lines

end;

End.

Delphi - .....................................

neoturk: ...Write to an access db using ado - sql ?...

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

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;

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

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;

procedure TfrmMain.Button1Click(Sender: TObject);

begin

ShowMessage(Format('ADO Version = %n', [GetADOVersion]));

end;

end.

Delphi - .....................................

neoturk: ...Write to an access db using ado - sql ?...

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

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;

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

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;

procedure TfrmMain.Button1Click(Sender: TObject);

begin

ShowMessage(Format('ADO Version = %n', [GetADOVersion]));

end;

end.

Delphi - .....................................

neoturk: ...Get the odbc datasource names ?...

uses

Registry;

procedure TForm1.GetDataSourceNames(System: Boolean);

var

reg: TRegistry;

begin

ListBox1.Items.Clear;

reg := TRegistry.Create;

try

if System then

reg.RootKey := HKEY_LOCAL_MACHINE

else

reg.RootKey := HKEY_CURRENT_USER;

if reg.OpenKey('SoftwareODBCODBC.INIODBC Data Sources', False) then

begin

reg.GetValueNames(ListBox1.Items);

end;

finally

reg.CloseKey;

FreeAndNil(reg);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

//System DSNs

GetDataSourceNames(True);

//User DSNs

GetDataSourceNames(False);

end;

Delphi - .....................................

neoturk: ...Get the odbc datasource names ?...

uses

Registry;

procedure TForm1.GetDataSourceNames(System: Boolean);

var

reg: TRegistry;

begin

ListBox1.Items.Clear;

reg := TRegistry.Create;

try

if System then

reg.RootKey := HKEY_LOCAL_MACHINE

else

reg.RootKey := HKEY_CURRENT_USER;

if reg.OpenKey('SoftwareODBCODBC.INIODBC Data Sources', False) then

begin

reg.GetValueNames(ListBox1.Items);

end;

finally

reg.CloseKey;

FreeAndNil(reg);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

//System DSNs

GetDataSourceNames(True);

//User DSNs

GetDataSourceNames(False);

end;

Delphi - .....................................

neoturk: ...Regenerate all out-of-date indexes on a given table ?...

procedure TForm1.Button1Click(Sender: TObject);

begin

Table.Close;

Table.Exclusive := True;

Table.Open;

DbiRegenIndexes(Table.Handle);

Table.Close;

end;

Delphi - .....................................

neoturk: ...Regenerate all out-of-date indexes on a given table ?...

procedure TForm1.Button1Click(Sender: TObject);

begin

Table.Close;

Table.Exclusive := True;

Table.Open;

DbiRegenIndexes(Table.Handle);

Table.Close;

end;

Delphi - .....................................

neoturk: ...Create a dbexpress-connection at runtime ?...

{

The normal way for Delphi and Kylix is just to check dbExpress,

put a TSQLConnection on a form then double-click the TSQLConnection to display

the Connection Editor and set parameter values (database path, connection name etc.)

to indicate the settings.

But in our example, all goes by runtime (path and login) with dbExpress we don't need

an alias or the BDE either.

}

procedure TVCLScanner.PostUser(const Email, FirstName, LastName: WideString);

var

Connection: TSQLConnection;

DataSet: TSQLDataSet;

begin

Connection := TSQLConnection.Create(nil);

with Connection do

begin

ConnectionName := 'VCLScanner';

DriverName := 'INTERBASE';

LibraryName := 'dbexpint.dll';

VendorLib := 'GDS32.DLL';

GetDriverFunc := 'getSQLDriverINTERBASE';

Params.Add('User_Name=SYSDBA');

Params.Add('Password=masterkey');

Params.Add('Database=milo2:D:frankwebservicesumlbank.gdb');

LoginPrompt := False;

Open;

end;

DataSet := TSQLDataSet.Create(nil);

with DataSet do

begin

SQLConnection := Connection;

CommandText := Format('INSERT INTO kings VALUES("%s","%s","%s")',

[Email, FirstN, LastN]);

try

ExecSQL;

except

end;

Connection.Close;

DataSet.Free;

Connection.Free;

end;

Delphi - .....................................

neoturk: ...Create a dbexpress-connection at runtime ?...

{

The normal way for Delphi and Kylix is just to check dbExpress,

put a TSQLConnection on a form then double-click the TSQLConnection to display

the Connection Editor and set parameter values (database path, connection name etc.)

to indicate the settings.

But in our example, all goes by runtime (path and login) with dbExpress we don't need

an alias or the BDE either.

}

procedure TVCLScanner.PostUser(const Email, FirstName, LastName: WideString);

var

Connection: TSQLConnection;

DataSet: TSQLDataSet;

begin

Connection := TSQLConnection.Create(nil);

with Connection do

begin

ConnectionName := 'VCLScanner';

DriverName := 'INTERBASE';

LibraryName := 'dbexpint.dll';

VendorLib := 'GDS32.DLL';

GetDriverFunc := 'getSQLDriverINTERBASE';

Params.Add('User_Name=SYSDBA');

Params.Add('Password=masterkey');

Params.Add('Database=milo2:D:frankwebservicesumlbank.gdb');

LoginPrompt := False;

Open;

end;

DataSet := TSQLDataSet.Create(nil);

with DataSet do

begin

SQLConnection := Connection;

CommandText := Format('INSERT INTO kings VALUES("%s","%s","%s")',

[Email, FirstN, LastN]);

try

ExecSQL;

except

end;

Connection.Close;

DataSet.Free;

Connection.Free;

end;

Delphi - .....................................

neoturk: ...Save a file to a tblobstream and read it back ?...

{

If you develop a database related software, then a very popular task is to

save some files (documents/images/reports/etc) in some BLOB field of table

and use these saved data later.

In this tip I want to show how this task could be solved.

}

// To save a file to BLOB:

procedure TForm1.Button1Click(Sender: TObject);

var

blob: TBlobStream;

begin

blob := yourDataset.CreateBlobStream(yourDataset.FieldByName('YOUR_BLOB'), bmWrite);

try

blob.Seek(0, soFromBeginning);

fs := TFileStream.Create('c:your_name.doc', fmOpenRead or

fmShareDenyWrite);

try

blob.CopyFrom(fs, fs.Size)

finally

fs.Free

end;

finally

blob.Free

end;

// To load from BLOB:

procedure TForm1.Button1Click(Sender: TObject);

var

blob: TBlobStream;

begin

blob := yourDataset.CreateBlobStream(yourDataset.FieldByName('YOUR_BLOB'), bmRead);

try

blob.Seek(0, soFromBeginning);

with TFileStream.Create('c:your_name.doc', fmCreate) do

try

CopyFrom(blob, blob.Size)

finally

Free

end;

finally

blob.Free

end;

{

Using this code you can work with any database engine (BDE/ADO/DAO/ODBC/etc)

and any file format (document of MS Word, spreadsheet of MS Excel, bitmap or

jpeg pictures, wav-files etc)

}

Delphi - .....................................

neoturk: ...Save a file to a tblobstream and read it back ?...

{

If you develop a database related software, then a very popular task is to

save some files (documents/images/reports/etc) in some BLOB field of table

and use these saved data later.

In this tip I want to show how this task could be solved.

}

// To save a file to BLOB:

procedure TForm1.Button1Click(Sender: TObject);

var

blob: TBlobStream;

begin

blob := yourDataset.CreateBlobStream(yourDataset.FieldByName('YOUR_BLOB'), bmWrite);

try

blob.Seek(0, soFromBeginning);

fs := TFileStream.Create('c:your_name.doc', fmOpenRead or

fmShareDenyWrite);

try

blob.CopyFrom(fs, fs.Size)

finally

fs.Free

end;

finally

blob.Free

end;

// To load from BLOB:

procedure TForm1.Button1Click(Sender: TObject);

var

blob: TBlobStream;

begin

blob := yourDataset.CreateBlobStream(yourDataset.FieldByName('YOUR_BLOB'), bmRead);

try

blob.Seek(0, soFromBeginning);

with TFileStream.Create('c:your_name.doc', fmCreate) do

try

CopyFrom(blob, blob.Size)

finally

Free

end;

finally

blob.Free

end;

{

Using this code you can work with any database engine (BDE/ADO/DAO/ODBC/etc)

and any file format (document of MS Word, spreadsheet of MS Excel, bitmap or

jpeg pictures, wav-files etc)

}

Delphi - .....................................

neoturk: ...Get infos about aliases ?...

{

Here's a demo to demonstrate how to get info about aliases in Delphi.

First, create a new project with a listbox and 3 labels (called ListBox1,

Label1, Label2, and Label3). Then add an OnCreate event handler for the form

with this code in it:

}

{

Das folgende Beispiel zeigt, wie man Infos von Aliasen ermitteln kann.

Erstelle ein neues Projekt und platziere eine Listbox und 3 Labels (ListBox1,

Label1, Label2, and Label3) auf der Form. Dann Schreibe im OnCreate Ereignis

folgenden Code:

}

procedure TForm1.FormCreate(Sender: TObject);

begin

{

GetAliasNames Populates a string list with the names of persistent

Borland Database Engine (BDE) aliases.

GetAliasNames fügt die Namen der dauerhaften

Aliase der Borland Database Engine (BDE) in eine Listbox.

}

Session.GetAliasNames(ListBox1.Items);

end;

{ Now add an OnClick event for the Listbox: }

{ Schreibe nun im OnClick Ereignis der Listbox diesen Code }

procedure TForm1.ListBox1Click(Sender: TObject);

var

tStr: array[0..100] of char;

Desc: DBDesc;

{

The DBDesc structure describes a database, using the following fields:

szName DBINAME Specifies the database alias name.

szText DBINAME Descriptive text.

szPhyName DBIPATH Specifies the physical name/path.

szDbType DBINAME Specifies the database type.

}

begin

if ListBox1.Items.Count = 0 then

exit;

StrPLCopy(tStr, ListBox1.Items.Strings[ListBox1.ItemIndex], High(tStr));

DbiGetDatabaseDesc(tStr, @Desc);

with Desc do

begin

Label1.Caption := StrPas(Desc.szName);

Label2.Caption := StrPas(Desc.szPhyName);

Label3.Caption := StrPas(Desc.szDbType);

Label4.Caption := StrPas(Desc.szText);

end;

// Now add the following to the 'uses' clause at the top of the unit:

// Folgende Units müssen noch in die Uses-Klausel aufgenommen werden:

uses

{...,}DB, DBTables, DBITypes, DBIProcs;

{********************************************************************}

{

This Examples is just another approach to get infos about aliases

Using 2 component (TListBox) and only use 1 uses clause (dbTables)

}

uses

{...}, DBTables;

type

TForm1 = class(TForm)

ListBox1: TListBox;

ListBox2: TListBox;

{..}

implementation

{..}

procedure TForm1.FormCreate(Sender: TObject);

begin

{Get Alias Names}

Session.GetAliasNames(ListBox1.Items);

end;

procedure TForm1.ListBox1Click(Sender: TObject);

begin

ListBox2.Items.Clear;

if ListBox1.Items.Count = 0 then

Exit;

{Get Alias Driver Names, like Standard, MsAccess, etc}

ListBox2.Items.Add('DRIVER=' + Session.GetAliasDriverName(ListBox1.Items.Strings

[ListBox1.ItemIndex]));

{Get Alias Parameters and add it parameters into listbox2}

Session.GetAliasParams(ListBox1.Items.Strings[ListBox1.ItemIndex], ListBox2.Items);

end;

end.

Delphi - .....................................

neoturk: ...Get infos about aliases ?...

{

Here's a demo to demonstrate how to get info about aliases in Delphi.

First, create a new project with a listbox and 3 labels (called ListBox1,

Label1, Label2, and Label3). Then add an OnCreate event handler for the form

with this code in it:

}

{

Das folgende Beispiel zeigt, wie man Infos von Aliasen ermitteln kann.

Erstelle ein neues Projekt und platziere eine Listbox und 3 Labels (ListBox1,

Label1, Label2, and Label3) auf der Form. Dann Schreibe im OnCreate Ereignis

folgenden Code:

}

procedure TForm1.FormCreate(Sender: TObject);

begin

{

GetAliasNames Populates a string list with the names of persistent

Borland Database Engine (BDE) aliases.

GetAliasNames fügt die Namen der dauerhaften

Aliase der Borland Database Engine (BDE) in eine Listbox.

}

Session.GetAliasNames(ListBox1.Items);

end;

{ Now add an OnClick event for the Listbox: }

{ Schreibe nun im OnClick Ereignis der Listbox diesen Code }

procedure TForm1.ListBox1Click(Sender: TObject);

var

tStr: array[0..100] of char;

Desc: DBDesc;

{

The DBDesc structure describes a database, using the following fields:

szName DBINAME Specifies the database alias name.

szText DBINAME Descriptive text.

szPhyName DBIPATH Specifies the physical name/path.

szDbType DBINAME Specifies the database type.

}

begin

if ListBox1.Items.Count = 0 then

exit;

StrPLCopy(tStr, ListBox1.Items.Strings[ListBox1.ItemIndex], High(tStr));

DbiGetDatabaseDesc(tStr, @Desc);

with Desc do

begin

Label1.Caption := StrPas(Desc.szName);

Label2.Caption := StrPas(Desc.szPhyName);

Label3.Caption := StrPas(Desc.szDbType);

Label4.Caption := StrPas(Desc.szText);

end;

// Now add the following to the 'uses' clause at the top of the unit:

// Folgende Units müssen noch in die Uses-Klausel aufgenommen werden:

uses

{...,}DB, DBTables, DBITypes, DBIProcs;

{********************************************************************}

{

This Examples is just another approach to get infos about aliases

Using 2 component (TListBox) and only use 1 uses clause (dbTables)

}

uses

{...}, DBTables;

type

TForm1 = class(TForm)

ListBox1: TListBox;

ListBox2: TListBox;

{..}

implementation

{..}

procedure TForm1.FormCreate(Sender: TObject);

begin

{Get Alias Names}

Session.GetAliasNames(ListBox1.Items);

end;

procedure TForm1.ListBox1Click(Sender: TObject);

begin

ListBox2.Items.Clear;

if ListBox1.Items.Count = 0 then

Exit;

{Get Alias Driver Names, like Standard, MsAccess, etc}

ListBox2.Items.Add('DRIVER=' + Session.GetAliasDriverName(ListBox1.Items.Strings

[ListBox1.ItemIndex]));

{Get Alias Parameters and add it parameters into listbox2}

Session.GetAliasParams(ListBox1.Items.Strings[ListBox1.ItemIndex], ListBox2.Items);

end;

end.

Delphi - .....................................

neoturk: ...Quickly create a paradox table using sql ?...

{

Here is a sample how to quickly create a Paradox table

with some field definied using a SQL language to do so

}

{

Hier ein Beispiel, wie man schnell eine Paradox Tabelle

mit einigen definierten Feldern mittels SQL erzeugen kann.

}

procedure TForm1.Button1Click(Sender: TObject);

begin

with Query1 do

begin

DatabaseName := 'DBDemos';

with SQL do

begin

Clear;

{

CREATE TABLE creates a table with the given name in the

current database

CREATE TABLE erzeugt eine Tabelle mit einem angegebenen

Namen in der aktuellen Datenbank

}

Add('CREATE TABLE "PDoxTbl.db" (ID AUTOINC,');

Add('Name CHAR(255),');

Add('PRIMARY KEY(ID))');

{

Call ExecSQL to execute the SQL statement currently

assigned to the SQL property.

Mit ExecSQL wird die Anweisung ausgeführt,

welche aktuell in der Eigenschaft SQL enthalten ist.

}

ExecSQL;

Clear;

Add('CREATE INDEX ByName ON "PDoxTbl.db" (Name)');

ExecSQL;

end;

{

As you can see SQL Language is a pretty familiar one.

If you understand SQL you can do everything with databases, and not only.

}

Delphi - .....................................

neoturk: ...Quickly create a paradox table using sql ?...

{

Here is a sample how to quickly create a Paradox table

with some field definied using a SQL language to do so

}

{

Hier ein Beispiel, wie man schnell eine Paradox Tabelle

mit einigen definierten Feldern mittels SQL erzeugen kann.

}

procedure TForm1.Button1Click(Sender: TObject);

begin

with Query1 do

begin

DatabaseName := 'DBDemos';

with SQL do

begin

Clear;

{

CREATE TABLE creates a table with the given name in the

current database

CREATE TABLE erzeugt eine Tabelle mit einem angegebenen

Namen in der aktuellen Datenbank

}

Add('CREATE TABLE "PDoxTbl.db" (ID AUTOINC,');

Add('Name CHAR(255),');

Add('PRIMARY KEY(ID))');

{

Call ExecSQL to execute the SQL statement currently

assigned to the SQL property.

Mit ExecSQL wird die Anweisung ausgeführt,

welche aktuell in der Eigenschaft SQL enthalten ist.

}

ExecSQL;

Clear;

Add('CREATE INDEX ByName ON "PDoxTbl.db" (Name)');

ExecSQL;

end;

{

As you can see SQL Language is a pretty familiar one.

If you understand SQL you can do everything with databases, and not only.

}

Delphi - .....................................

neoturk: ...Create an autoincrement using sql ?...

{

Lets say that we wish to create a fallawing number (Autoincrese) of an item,

without using the AutoIncrese filed.

This is usfull when for example there is more users from the same IP that log

in or any other things that you wish.

This example will show you how to do it with some checking of filled data,

but it can be done anyway you wish.

You need a Table with at least 2 fileds with number casting, and a TQUERY component.

}

function TForm1.GetNextNumber : integer;

begin

qryMain.Active := False;

qryMain.SQL.Clear;

qryMain.SQL.Add('Select Max(FieldToIncrease) from tblMain where (Cheking >=1);');

qryMain.Active := True; //We executed the query

if qryMain.RecordCount >= 0 then

result := qryMain.FieldByName('FieldToIncrese').AsInteger +1;

else result := 1;

end;

...

procedure TForm1.SetNextNumber;

begin

//You must first see if the table is in insert/update mode before using this procedure.

tblMain.FieldByName('FieldToIncrese').AsInteger := GetNextNumber;

end;

Delphi - .....................................

neoturk: ...Create an autoincrement using sql ?...

{

Lets say that we wish to create a fallawing number (Autoincrese) of an item,

without using the AutoIncrese filed.

This is usfull when for example there is more users from the same IP that log

in or any other things that you wish.

This example will show you how to do it with some checking of filled data,

but it can be done anyway you wish.

You need a Table with at least 2 fileds with number casting, and a TQUERY component.

}

function TForm1.GetNextNumber : integer;

begin

qryMain.Active := False;

qryMain.SQL.Clear;

qryMain.SQL.Add('Select Max(FieldToIncrease) from tblMain where (Cheking >=1);');

qryMain.Active := True; //We executed the query

if qryMain.RecordCount >= 0 then

result := qryMain.FieldByName('FieldToIncrese').AsInteger +1;

else result := 1;

end;

...

procedure TForm1.SetNextNumber;

begin

//You must first see if the table is in insert/update mode before using this procedure.

tblMain.FieldByName('FieldToIncrese').AsInteger := GetNextNumber;

end;

Delphi - .....................................

neoturk: ...Change the tdbnavigator images ?...

procedure ChangeDBNavImage(DBnav: TDbNavigator);

var

i: Integer;

tempGlyph: TBitmap;

ExePath: string;

begin

ExePath := ExtractFilePath(Application.ExeName);

tempGlyph := TBitmap.Create;

try

with DBNav do

begin

for i := 0 to ControlCount - 1 do

begin

if Controls[i].ClassName = 'TNavButton' then

begin

case TNavButton(Controls[i]).Index of

nbFirst: tempGlyph.LoadFromFile(ExePath + 'first.bmp');

nbPrior: tempGlyph.LoadFromFile(ExePath + 'previous.bmp');

nbNext: tempGlyph.LoadFromFile(ExePath + 'Next.bmp');

nbLast: tempGlyph.LoadFromFile(ExePath + 'Last.bmp');

nbInsert: tempGlyph.LoadFromFile(ExePath + 'Insert.bmp');

nbDelete: tempGlyph.LoadFromFile(ExePath + 'Delete.bmp');

nbEdit: tempGlyph.LoadFromFile(ExePath + 'Edit.bmp');

nbPost: tempGlyph.LoadFromFile(ExePath + 'Post.bmp');

nbCancel: tempGlyph.LoadFromFile(ExePath + 'Cancel.bmp');

nbRefresh: tempGlyph.LoadFromFile(ExePath + 'Refresh.bmp');

end;

TNavButton(Controls[i]).Glyph := tempGlyph;

end;

finally

tempGlyph.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ChangeDBNavImage(DBNavigator1);

end;

Delphi - .....................................

neoturk: ...Change the tdbnavigator images ?...

procedure ChangeDBNavImage(DBnav: TDbNavigator);

var

i: Integer;

tempGlyph: TBitmap;

ExePath: string;

begin

ExePath := ExtractFilePath(Application.ExeName);

tempGlyph := TBitmap.Create;

try

with DBNav do

begin

for i := 0 to ControlCount - 1 do

begin

if Controls[i].ClassName = 'TNavButton' then

begin

case TNavButton(Controls[i]).Index of

nbFirst: tempGlyph.LoadFromFile(ExePath + 'first.bmp');

nbPrior: tempGlyph.LoadFromFile(ExePath + 'previous.bmp');

nbNext: tempGlyph.LoadFromFile(ExePath + 'Next.bmp');

nbLast: tempGlyph.LoadFromFile(ExePath + 'Last.bmp');

nbInsert: tempGlyph.LoadFromFile(ExePath + 'Insert.bmp');

nbDelete: tempGlyph.LoadFromFile(ExePath + 'Delete.bmp');

nbEdit: tempGlyph.LoadFromFile(ExePath + 'Edit.bmp');

nbPost: tempGlyph.LoadFromFile(ExePath + 'Post.bmp');

nbCancel: tempGlyph.LoadFromFile(ExePath + 'Cancel.bmp');

nbRefresh: tempGlyph.LoadFromFile(ExePath + 'Refresh.bmp');

end;

TNavButton(Controls[i]).Glyph := tempGlyph;

end;

finally

tempGlyph.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ChangeDBNavImage(DBNavigator1);

end;

Delphi - .....................................

neoturk: ...Automate logon for paradox tables ?...

{

The table component's ACTIVE property must be set to FALSE

(If it is active before you have added the pasword, you will be prompted).

Then, put this code in the handler for the form's OnCreate event:

}

Session.AddPassword('My secret password');

Table1.Active := True;

{

Once you close the table, you can remove the password with

RemovePassword('My secret password'),

or you can remove all current passwords with RemoveAllPasswords.

(Note: This is for Paradox tables only.)

}

Delphi - .....................................

neoturk: ...Automate logon for paradox tables ?...

{

The table component's ACTIVE property must be set to FALSE

(If it is active before you have added the pasword, you will be prompted).

Then, put this code in the handler for the form's OnCreate event:

}

Session.AddPassword('My secret password');

Table1.Active := True;

{

Once you close the table, you can remove the password with

RemovePassword('My secret password'),

or you can remove all current passwords with RemoveAllPasswords.

(Note: This is for Paradox tables only.)

}

Delphi - .....................................

neoturk: ...Circumvent the 'index not found' exception [dbase table] ?...

{Q: How do I open a dBASE table without the required MDX file?

I keep getting an "Index not found..." exception.}

{A: When you create a dBASE table with a production index (MDX), a

special byte is set in the header of the DBF file. When you

subsequently attempt to re-open the table, the dBASE driver

will read that special byte, and if it is set, it will also

attempt to open the MDX file. When the MDX file cannot be

opened, an exception is raised.

To work around this problem, you need to reset the byte (byte

28 decimal) in the DBF file that causes the MDX dependency

to zero.

The following unit is a simple example of how to handle the

exeption on the table open, reset the byte in the DBF file,

and re-open the table.}

unit Fixit;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,

Controls, Forms, Dialogs, StdCtrls, DB, DBTables, Grids, DBGrids;

type

TForm1 = class(TForm)

Table1: TTable;

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

const

TheTableDir = 'c:temp';

TheTableName = 'animals.dbf';

procedure RemoveMDXByte(dbFile: string);

{ This procedure accepts a DBF file as a parameter. It will patch}

{ the DBF header, so that it no longer requires the MDX file }

const

Value: Byte = 0;

var

F: file of byte;

begin

AssignFile(F, dbFile);

Reset(F);

Seek(F, 28);

Write(F, Value);

CloseFile(F);

end;

procedure TForm1.Button1Click(Sender: TObject);

{ This procedure is called in response to a button click. It }

{ attempts to open a table, and, if it can't find the .MDX file, }

{ it patches the DBF file and re-execute the procedure to }

{ re-open the table without the MDX }

begin

try

{ set the directory for the table }

Table1.DatabaseName := ThheTableDir;

{ set the table name }

Table1.TableName := TheTableName;

{ attempt to open the table }

Table1.Open;

except

on E: EDBEngineError do

{ The following message indicates the MDX wasn't found: }

if Pos('Index does not exist. File', E.Message) > 0 then

begin

{ Tell user what's going on. }

MessageDlg('MDX file not found.Attempting to Open

without Index.', mtWarning, [mbOK], 0);

{ remove the MDX byte from the table header }

RemoveMDXByte(TheTableDir + TheTableName);

{ Send the button a message to make it think it was }

{ pressed again. Doing so will cause this procedure to }

{ execute again, and the table will be opened without }

{ the MDX }

PostMessage(Button1.Handle, cn_Command, bn_Clicked, 0);

end;

end.

Delphi - .....................................

neoturk: ...Circumvent the 'index not found' exception [dbase table] ?...

{Q: How do I open a dBASE table without the required MDX file?

I keep getting an "Index not found..." exception.}

{A: When you create a dBASE table with a production index (MDX), a

special byte is set in the header of the DBF file. When you

subsequently attempt to re-open the table, the dBASE driver

will read that special byte, and if it is set, it will also

attempt to open the MDX file. When the MDX file cannot be

opened, an exception is raised.

To work around this problem, you need to reset the byte (byte

28 decimal) in the DBF file that causes the MDX dependency

to zero.

The following unit is a simple example of how to handle the

exeption on the table open, reset the byte in the DBF file,

and re-open the table.}

unit Fixit;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,

Controls, Forms, Dialogs, StdCtrls, DB, DBTables, Grids, DBGrids;

type

TForm1 = class(TForm)

Table1: TTable;

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

const

TheTableDir = 'c:temp';

TheTableName = 'animals.dbf';

procedure RemoveMDXByte(dbFile: string);

{ This procedure accepts a DBF file as a parameter. It will patch}

{ the DBF header, so that it no longer requires the MDX file }

const

Value: Byte = 0;

var

F: file of byte;

begin

AssignFile(F, dbFile);

Reset(F);

Seek(F, 28);

Write(F, Value);

CloseFile(F);

end;

procedure TForm1.Button1Click(Sender: TObject);

{ This procedure is called in response to a button click. It }

{ attempts to open a table, and, if it can't find the .MDX file, }

{ it patches the DBF file and re-execute the procedure to }

{ re-open the table without the MDX }

begin

try

{ set the directory for the table }

Table1.DatabaseName := ThheTableDir;

{ set the table name }

Table1.TableName := TheTableName;

{ attempt to open the table }

Table1.Open;

except

on E: EDBEngineError do

{ The following message indicates the MDX wasn't found: }

if Pos('Index does not exist. File', E.Message) > 0 then

begin

{ Tell user what's going on. }

MessageDlg('MDX file not found.Attempting to Open

without Index.', mtWarning, [mbOK], 0);

{ remove the MDX byte from the table header }

RemoveMDXByte(TheTableDir + TheTableName);

{ Send the button a message to make it think it was }

{ pressed again. Doing so will cause this procedure to }

{ execute again, and the table will be opened without }

{ the MDX }

PostMessage(Button1.Handle, cn_Command, bn_Clicked, 0);

end;

end.

Delphi - .....................................

neoturk: ...Make a virtual table [inmemory tables] ?...

{

This is an InMemoryTable example. Free for anyone to use, modify and do

whatever else you wish.

Just like all things free it comes with no guarantees.

I cannot be responsible for any damage this code may cause.

Let me repeat this:

WARNING! THIS CODE IS PROVIDED AS IS WITH NO GUARANTEES OF ANY KIND!

USE THIS AT YOUR OWN RISK - YOU ARE THE ONLY PERSON RESPONSIBLE FOR

ANY DAMAGE THIS CODE MAY CAUSE - YOU HAVE BEEN WARNED!

THANKS to Steve Garland <72700.2407@compuserve.com> for his help.

He created his own variation of an in-memory table component and

I used it to get started.

InMemory tables are a feature of the Borland Database Engine (BDE).

InMemory tables are created in RAM and deleted when you close them.

They are much faster and are very useful when you need fast operations on

small tables. This example uses the DbiCreateInMemoryTable DBE function call.

This object should work just like a regular table, except InMemory

tables do not support certain features (like referntial integrity,

secondary indexes and BLOBs) and currently this code doesn't do anything to

prevent you from trying to use them. You will probably get some error if

you try to create a memo field.

}

unit Inmem;

interface

uses DBTables, WinTypes, WinProcs, DBITypes, DBIProcs, DB, SysUtils;

type

TInMemoryTable = class(TTable)

private

hCursor: hDBICur;

procedure EncodeFieldDesc(var FieldDesc: FLDDesc;

const Name: string; DataType: TFieldType; Size: Word);

function CreateHandle: HDBICur; override;

public

procedure CreateTable;

end;

implementation

{

Luckely this function is virtual - so I could override it. In the

original VCL code for TTable this function actually opens the table -

but since we already have the handle to the table - we just return it

}

function TInMemoryTable.CreateHandle;

begin

Result := hCursor;

end;

{

This function is cut-and-pasted from the VCL source code. I had to do

this because it is declared private in the TTable component so I had no

access to it from here.

}

procedure TInMemoryTable.EncodeFieldDesc(var FieldDesc: FLDDesc;

const Name: string; DataType: TFieldType; Size: Word);

const

TypeMap: array[TFieldType] of Byte = (fldUNKNOWN, fldZSTRING, fldINT16,

fldINT32, fldUINT16, fldBOOL,

fldFLOAT, fldFLOAT, fldBCD, fldDATE, fldTIME, fldTIMESTAMP, fldBYTES,

fldVARBYTES, fldBLOB, fldBLOB, fldBLOB);

begin

with FieldDesc do

begin

AnsiToNative(Locale, Name, szName, SizeOf(szName) - 1);

iFldType := TypeMap[DataType];

case DataType of

ftString, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic:

iUnits1 := Size;

ftBCD:

begin

iUnits1 := 32;

iUnits2 := Size;

end;

case DataType of

ftCurrency:

iSubType := fldstMONEY;

ftBlob:

iSubType := fldstBINARY;

ftMemo:

iSubType := fldstMEMO;

ftGraphic:

iSubType := fldstGRAPHIC;

end;

{

This is where all the fun happens. I copied this function from the VCL

source and then changed it to use DbiCreateInMemoryTable instead of

DbiCreateTable.

Since InMemory tables do not support Indexes - I took all of the

index-related things out

}

procedure TInMemoryTable.CreateTable;

var

I: Integer;

pFieldDesc: pFLDDesc;

szTblName: DBITBLNAME;

iFields: Word;

Dogs: pfldDesc;

begin

CheckInactive;

if FieldDefs.Count = 0 then

for I := 0 to FieldCount - 1 do

with Fields[I] do

if not Calculated then

FieldDefs.Add(FieldName, DataType, Size, Required);

pFieldDesc := nil;

SetDBFlag(dbfTable, True);

try

AnsiToNative(Locale, TableName, szTblName, SizeOf(szTblName) - 1);

iFields := FieldDefs.Count;

pFieldDesc := AllocMem(iFields * SizeOf(FLDDesc));

for I := 0 to FieldDefs.Count - 1 do

with FieldDefs[I] do

begin

EncodeFieldDesc(PFieldDescList(pFieldDesc)^[I], Name,

DataType, Size);

end;

{ the driver type is nil = logical fields }

Check(DbiTranslateRecordStructure(nil, iFields, pFieldDesc,

nil, nil, pFieldDesc));

{ here we go - this is where hCursor gets its value }

Check(DbiCreateInMemTable(DBHandle, szTblName, iFields, pFieldDesc, hCursor));

finally

if pFieldDesc <> nil then FreeMem(pFieldDesc, iFields * SizeOf(FLDDesc));

SetDBFlag(dbfTable, False);

end;

end.