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;
end;
case DataType of
ftCurrency:
iSubType := fldstMONEY;
ftBlob:
iSubType := fldstBINARY;
ftMemo:
iSubType := fldstMEMO;
ftGraphic:
iSubType := fldstGRAPHIC;
end;
end;
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;
end.
Delphi - .....................................
neoturk: ...Handle edbengineerror exceptions ?...
{
Information that describes the conditions of a database engine error can
be obtained for use by an application through the use of an EDBEngineError
exception. EDBEngineError exceptions are handled in an application through
the use of a try..except construct. When an EDBEngineError exception
occurs, a EDBEngineError object would be created and various fields in that
EDBEngineError object would be used to programmatically determine what
went wrong and thus what needs to be done to correct the situation. Also,
more than one error message may be generated for a given exception. This
requires iterating through the multiple error messages to get needed infor-
mation.
}
{The fields that are most pertinent to this context are:}
{ ErrorCount: type Integer; indicates the number of errors that are in
the Errors property; counting begins at zero.
Errors: type TDBError; a set of record-like structures that contain
information about each specific error generated; each record is
accessed via an index number of type Integer.
Errors.ErrorCode: type DBIResult; indicating the BDE error code for the
error in the current Errors record.
Errors.Category: type Byte; category of the error referenced by the
ErrorCode field.
Errors.SubCode: type Byte; subcode for the value of ErrorCode.
Errors.NativeError: type LongInt; remote error code returned from the
server; if zero, the error is not a server error; SQL statement
return codes appear in this field.
Errors.Message: type TMessageStr; if the error is a server error, the
server message for the error in the current Errors record; if not a
server error, a BDE error message.}
{
In a try..except construct, the EDBEngineError object is created directly
in the except section of the construct. Once created, fields may be
accessed normally, or the object may be passed to another procedure for
inspection of the errors. Passing the EDBEngineError object to a special-
ized procedure is preferred for an application to make the process more
modular, reducing the amount of repeated code for parsing the object for
error information. Alternately, a custom component could be created to
serve this purpose, providing a set of functionality that is easily trans-
ported across applications. The example below only demonstrates creating
the DBEngineError object, passing it to a procedure, and parsing the
object to extract error information.
}
{
In a try..except construct, the DBEngineError can be created with syntax
such as that below:
}
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
if Edit1.Text > ' ' then
begin
Table1.FieldByName('Number').AsInteger := StrToInt(Edit1.Text);
try
Table1.Post;
except
on E: EDBEngineError do
ShowError(E);
end;
end;
end;
{
In this procedure, an attempt is made to change the value of a field in a
table and then call the Post method of the corresponding TTable component.
Only the attempt to post the change is being trapped in the try..except
construct. If an EDBEngineError occurs, the except section of the con-
struct is executed, which creates the EDBEngineError object (E) and then
passes it to the procedure ShowError. Note that only an EDBEngineError
exception is being accounted for in this construct. In a real-world sit-
uation, this would likely be accompanied by checking for other types of
exceptions.
The procedure ShowError takes the EDBEngineError, passed as a parameter,
and queries the object for contained errors. In this example, information
about the errors are displayed in a TMemo component. Alternately, the
extracted values may never be displayed, but instead used as the basis for
logic branching so the application can react to the errors. The first step
in doing this is to establish the number of errors that actually occurred.
This is the purpose of the ErrorCount property. This property supplies a
value of type Integer that may be used to build a for loop to iterate
through the errors contained in the object. Once the number of errors
actually contained in the object is known, a loop can be used to visit
each existing error (each represented by an Errors property record) and
extract information about each error to be inserted into the TMemo comp-
onent.
}
procedure TForm1.ShowError(AExc: EDBEngineError);
var
i: Integer;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('Number of errors: ' + IntToStr(AExc.ErrorCount));
Memo1.Lines.Add('');
{Iterate through the Errors records}
for i := 0 to AExc.ErrorCount - 1 do
begin
Memo1.Lines.Add('Message: ' + AExc.Errors[i].Message);
Memo1.Lines.Add(' Category: ' +
IntToStr(AExc.Errors[i].Category));
Memo1.Lines.Add(' Error Code: ' +
IntToStr(AExc.Errors[i].ErrorCode));
Memo1.Lines.Add(' SubCode: ' +
IntToStr(AExc.Errors[i].SubCode));
Memo1.Lines.Add(' Native Error: ' +
IntToStr(AExc.Errors[i].NativeError));
Memo1.Lines.Add('');
end;
end;
Delphi - .....................................
neoturk: ...Handle edbengineerror exceptions ?...
{
Information that describes the conditions of a database engine error can
be obtained for use by an application through the use of an EDBEngineError
exception. EDBEngineError exceptions are handled in an application through
the use of a try..except construct. When an EDBEngineError exception
occurs, a EDBEngineError object would be created and various fields in that
EDBEngineError object would be used to programmatically determine what
went wrong and thus what needs to be done to correct the situation. Also,
more than one error message may be generated for a given exception. This
requires iterating through the multiple error messages to get needed infor-
mation.
}
{The fields that are most pertinent to this context are:}
{ ErrorCount: type Integer; indicates the number of errors that are in
the Errors property; counting begins at zero.
Errors: type TDBError; a set of record-like structures that contain
information about each specific error generated; each record is
accessed via an index number of type Integer.
Errors.ErrorCode: type DBIResult; indicating the BDE error code for the
error in the current Errors record.
Errors.Category: type Byte; category of the error referenced by the
ErrorCode field.
Errors.SubCode: type Byte; subcode for the value of ErrorCode.
Errors.NativeError: type LongInt; remote error code returned from the
server; if zero, the error is not a server error; SQL statement
return codes appear in this field.
Errors.Message: type TMessageStr; if the error is a server error, the
server message for the error in the current Errors record; if not a
server error, a BDE error message.}
{
In a try..except construct, the EDBEngineError object is created directly
in the except section of the construct. Once created, fields may be
accessed normally, or the object may be passed to another procedure for
inspection of the errors. Passing the EDBEngineError object to a special-
ized procedure is preferred for an application to make the process more
modular, reducing the amount of repeated code for parsing the object for
error information. Alternately, a custom component could be created to
serve this purpose, providing a set of functionality that is easily trans-
ported across applications. The example below only demonstrates creating
the DBEngineError object, passing it to a procedure, and parsing the
object to extract error information.
}
{
In a try..except construct, the DBEngineError can be created with syntax
such as that below:
}
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
if Edit1.Text > ' ' then
begin
Table1.FieldByName('Number').AsInteger := StrToInt(Edit1.Text);
try
Table1.Post;
except
on E: EDBEngineError do
ShowError(E);
end;
end;
end;
{
In this procedure, an attempt is made to change the value of a field in a
table and then call the Post method of the corresponding TTable component.
Only the attempt to post the change is being trapped in the try..except
construct. If an EDBEngineError occurs, the except section of the con-
struct is executed, which creates the EDBEngineError object (E) and then
passes it to the procedure ShowError. Note that only an EDBEngineError
exception is being accounted for in this construct. In a real-world sit-
uation, this would likely be accompanied by checking for other types of
exceptions.
The procedure ShowError takes the EDBEngineError, passed as a parameter,
and queries the object for contained errors. In this example, information
about the errors are displayed in a TMemo component. Alternately, the
extracted values may never be displayed, but instead used as the basis for
logic branching so the application can react to the errors. The first step
in doing this is to establish the number of errors that actually occurred.
This is the purpose of the ErrorCount property. This property supplies a
value of type Integer that may be used to build a for loop to iterate
through the errors contained in the object. Once the number of errors
actually contained in the object is known, a loop can be used to visit
each existing error (each represented by an Errors property record) and
extract information about each error to be inserted into the TMemo comp-
onent.
}
procedure TForm1.ShowError(AExc: EDBEngineError);
var
i: Integer;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('Number of errors: ' + IntToStr(AExc.ErrorCount));
Memo1.Lines.Add('');
{Iterate through the Errors records}
for i := 0 to AExc.ErrorCount - 1 do
begin
Memo1.Lines.Add('Message: ' + AExc.Errors[i].Message);
Memo1.Lines.Add(' Category: ' +
IntToStr(AExc.Errors[i].Category));
Memo1.Lines.Add(' Error Code: ' +
IntToStr(AExc.Errors[i].ErrorCode));
Memo1.Lines.Add(' SubCode: ' +
IntToStr(AExc.Errors[i].SubCode));
Memo1.Lines.Add(' Native Error: ' +
IntToStr(AExc.Errors[i].NativeError));
Memo1.Lines.Add('');
end;
end;
Delphi - .....................................
neoturk: ...Define bde aliases in code ?...
{A:
This Technical Information document will help step thru concepts regarding
the creation and use of ALIASES within your Delphi Applications.
Typically, you use the BDE Configuration Utility BDECFG.EXE to create and
configure aliases outside of Delphi. However, with the use of the TDatabase
component, you have the ability to create and use this ALIAS within your
application-- not pre-defined in the IDAPI.CFG.
The ability to create Aliases that are only available within your
application is important. Aliases specify the location of database tables
and connection parameters for database servers.
Ultimately, you can gain the advantages of using ALIASES within your
applications-- without having to worry about the existance of a
configuration entry in the IDAPI.CFG when you deploy your
application. }
{Summary of Examples:}
{Example #1:}
{Example #1 creates and configures an Alias to use
STANDARD (.DB, .DBF) databases. The Alias is
then used by a TTable component.}
{Example #2:}
{Example #2 creates and configures an Alias to use
an INTERBASE database (.gdb). The Alias is then
used by a TQuery component to join two tables of
the database.}
{Example #3:}
{Example #3 creates and configures an Alias to use
STANDARD (.DB, .DBF) databases. This example
demonstrates how user input can be used to
configure the Alias during run-time.}
{Example #1: Use of a .DB or .DBF database (STANDARD)}
{1. Create a New Project.
2. Place the following components on the form: - TDatabase, TTable,
TDataSource, TDBGrid, and TButton.
3. Double-click on the TDatabase component or choose Database Editor from
the TDatabase SpeedMenu to launch the Database Property editor.
4. Set the Database Name to 'MyNewAlias'. This name will serve as your
ALIAS name used in the DatabaseName Property for dataset components such as
TTable, TQuery, TStoredProc.
5. Select STANDARD as the Driveer Name.
6. Click on the Defaults Button. This will automatically add a PATH= in
the Parameter Overrides section.
7. Set the PATH= to C:DELPHIDEMOSDATA (PATH=C:DELPHIDEMOSDATA)
8. Click the OK button to close the Database Dialog.
9. Set the TTable DatabaseName Property to 'MyNewAlias'.
10. Set the TDataSource's DataSet Property to 'Table1'.
11. Set the DBGrid's DataSource Property to 'DataSource1'.
12. Place the following code inside of the TButton's OnClick event.}
procedure TForm1.Button1Click(Sender: TObject);
begin
Table1.TableName := 'CUSTOMER';
Table1.Active := True;
end;
{13. Run the application.}
{*** If you want an alternative way to steps 3 - 11, place the following
code inside of the TButton's OnClick event.}
procedure TForm1.Button1Click(Sender: TObject);
begin
Database1.DatabaseName := 'MyNewAlias';
Database1.DriverName := 'STANDARD';
Database1.Params.Clear;
Database1.Params.Add('PATH=C:DELPHIDEMOSDATA');
Table1.DatabaseName := 'MyNewAlias';
Table1.TableName := 'CUSTOMER';
Table1.Active := True;
DataSource1.DataSet := Table1;
DBGrid1.DataSource := DataSource1;
end;
{Example #2: Use of a INTERBASE database}
{1. Create a New Project.
2. Place the following components on the form: - TDatabase, TQuery,
TDataSource, TDBGrid, and TButton.
3. Double-click on the TDatabase component or choose Database Editor from
the TDatabase SpeedMenu to launch the Database Property editor.
4. Set the Database Name to 'MyNewAlias'. This name will serve as your
ALIAS name used in the DatabaseName Property for dataset components such as
TTable, TQuery, TStoredProc.
5. Select INTRBASE as the Driver Name.
6. Click on the Defaults Button. This will automatically add the
following entries in the Parameter Overrides section.
SERVER NAME=IB_SERVEER:/PATH/DATABASE.GDB
USER NAME=MYNAME
OPEN MODE=READ/WRITE
SCHEMA CACHE SIZE=8
LANGDRIVER=
SQLQRYMODE=
SQLPASSTHRU MODE=NOT SHARED
SCHEMA CACHE TIME=-1
PASSWORD=
7. Set the following parameters
SERVER NAME=C:IBLOCALEXAMPLESEMPLOYEE.GDB
USER NAME=SYSDBA
OPEN MODE=READ/WRITE
SCHEMA CACHE SIZE=8
LANGDRIVER=
SQLQRYMODE=
SQLPASSTHRU MODE=NOT SHARED
SCHEMA CACHE TIME=-1
PASSWORD=masterkey
8. Set the TDatabase LoginPrompt Property to 'False'. If you supply the
PASSWORD in the Parameter Overrides section and set the LoginPrompt to
'False', you will not be prompted for the
password when connecting to the database. WARNING: If an incorrect
password in entered in the Parameter Overrides section and LoginPrompt is
set to 'False', you are not prompted by the Password dialog to re-enter a
valid password.
9. Click the OK button to close the Database Dialog.
10. Set the TQuery DatabaseName Property to 'MyNewAliias'.
11. Set the TDataSource's DataSet Property to 'Query1'.
12. Set the DBGrid's DataSource Property to 'DataSource1'.
13. Place the following code inside of the TButton's OnClick event.}
procedure TForm1.Button1Click(Sender: TObject);
begin
Query1.SQL.Clear;
Query1.SQL.Add('SELECT DISTINCT * FROM CUSTOMER C, SALES S
WHERE(S.CUST_NO = C.CUST_NO)
ORDER BY C.CUST_NO, C.CUSTOMER');
Query1.Active := True;
end;
{14. Run the application.}
{Example #3: User-defined Alias Configuration}
{This example brings up a input dialog and prompts the user to enter the
directory to which the ALIAS is to be configured to.
The directory, servername, path, database name, and other neccessary Alias
parameters can be read into the application from use of an input dialog or
.INI file.
1. Follow the steps (1-11) in Example #1.
2. Place the following code inside of the TButton's OnClick event.}
procedure TForm1.Buttton1Click(Sender: TObject);
var
NewString: string;
ClickedOK: Boolean;
begin
NewString := 'C:';
ClickedOK := InputQuery('Database Path',
'Path: --> C:DELPHIDEMOSDATA', NewString);
if ClickedOK then
begin
Database1.DatabaseName := 'MyNewAlias';
Database1.DriverName := 'STANDARD';
Database1.Params.Clear;
Database1.Params.Add('Path=' + NewString);
Table1.DatabaseName := 'MyNewAlias';
Table1.TableName := 'CUSTOMER';
Table1.Active := True;
DataSource1.DataSet := Table1;
DBGrid1.DataSource := DataSource1;
end;
end;
//3. Run the Application.
Delphi - .....................................
neoturk: ...Define bde aliases in code ?...
{A:
This Technical Information document will help step thru concepts regarding
the creation and use of ALIASES within your Delphi Applications.
Typically, you use the BDE Configuration Utility BDECFG.EXE to create and
configure aliases outside of Delphi. However, with the use of the TDatabase
component, you have the ability to create and use this ALIAS within your
application-- not pre-defined in the IDAPI.CFG.
The ability to create Aliases that are only available within your
application is important. Aliases specify the location of database tables
and connection parameters for database servers.
Ultimately, you can gain the advantages of using ALIASES within your
applications-- without having to worry about the existance of a
configuration entry in the IDAPI.CFG when you deploy your
application. }
{Summary of Examples:}
{Example #1:}
{Example #1 creates and configures an Alias to use
STANDARD (.DB, .DBF) databases. The Alias is
then used by a TTable component.}
{Example #2:}
{Example #2 creates and configures an Alias to use
an INTERBASE database (.gdb). The Alias is then
used by a TQuery component to join two tables of
the database.}
{Example #3:}
{Example #3 creates and configures an Alias to use
STANDARD (.DB, .DBF) databases. This example
demonstrates how user input can be used to
configure the Alias during run-time.}
{Example #1: Use of a .DB or .DBF database (STANDARD)}
{1. Create a New Project.
2. Place the following components on the form: - TDatabase, TTable,
TDataSource, TDBGrid, and TButton.
3. Double-click on the TDatabase component or choose Database Editor from
the TDatabase SpeedMenu to launch the Database Property editor.
4. Set the Database Name to 'MyNewAlias'. This name will serve as your
ALIAS name used in the DatabaseName Property for dataset components such as
TTable, TQuery, TStoredProc.
5. Select STANDARD as the Driveer Name.
6. Click on the Defaults Button. This will automatically add a PATH= in
the Parameter Overrides section.
7. Set the PATH= to C:DELPHIDEMOSDATA (PATH=C:DELPHIDEMOSDATA)
8. Click the OK button to close the Database Dialog.
9. Set the TTable DatabaseName Property to 'MyNewAlias'.
10. Set the TDataSource's DataSet Property to 'Table1'.
11. Set the DBGrid's DataSource Property to 'DataSource1'.
12. Place the following code inside of the TButton's OnClick event.}
procedure TForm1.Button1Click(Sender: TObject);
begin
Table1.TableName := 'CUSTOMER';
Table1.Active := True;
end;
{13. Run the application.}
{*** If you want an alternative way to steps 3 - 11, place the following
code inside of the TButton's OnClick event.}
procedure TForm1.Button1Click(Sender: TObject);
begin
Database1.DatabaseName := 'MyNewAlias';
Database1.DriverName := 'STANDARD';
Database1.Params.Clear;
Database1.Params.Add('PATH=C:DELPHIDEMOSDATA');
Table1.DatabaseName := 'MyNewAlias';
Table1.TableName := 'CUSTOMER';
Table1.Active := True;
DataSource1.DataSet := Table1;
DBGrid1.DataSource := DataSource1;
end;
{Example #2: Use of a INTERBASE database}
{1. Create a New Project.
2. Place the following components on the form: - TDatabase, TQuery,
TDataSource, TDBGrid, and TButton.
3. Double-click on the TDatabase component or choose Database Editor from
the TDatabase SpeedMenu to launch the Database Property editor.
4. Set the Database Name to 'MyNewAlias'. This name will serve as your
ALIAS name used in the DatabaseName Property for dataset components such as
TTable, TQuery, TStoredProc.
5. Select INTRBASE as the Driver Name.
6. Click on the Defaults Button. This will automatically add the
following entries in the Parameter Overrides section.
SERVER NAME=IB_SERVEER:/PATH/DATABASE.GDB
USER NAME=MYNAME
OPEN MODE=READ/WRITE
SCHEMA CACHE SIZE=8
LANGDRIVER=
SQLQRYMODE=
SQLPASSTHRU MODE=NOT SHARED
SCHEMA CACHE TIME=-1
PASSWORD=
7. Set the following parameters
SERVER NAME=C:IBLOCALEXAMPLESEMPLOYEE.GDB
USER NAME=SYSDBA
OPEN MODE=READ/WRITE
SCHEMA CACHE SIZE=8
LANGDRIVER=
SQLQRYMODE=
SQLPASSTHRU MODE=NOT SHARED
SCHEMA CACHE TIME=-1
PASSWORD=masterkey
8. Set the TDatabase LoginPrompt Property to 'False'. If you supply the
PASSWORD in the Parameter Overrides section and set the LoginPrompt to
'False', you will not be prompted for the
password when connecting to the database. WARNING: If an incorrect
password in entered in the Parameter Overrides section and LoginPrompt is
set to 'False', you are not prompted by the Password dialog to re-enter a
valid password.
9. Click the OK button to close the Database Dialog.
10. Set the TQuery DatabaseName Property to 'MyNewAliias'.
11. Set the TDataSource's DataSet Property to 'Query1'.
12. Set the DBGrid's DataSource Property to 'DataSource1'.
13. Place the following code inside of the TButton's OnClick event.}
procedure TForm1.Button1Click(Sender: TObject);
begin
Query1.SQL.Clear;
Query1.SQL.Add('SELECT DISTINCT * FROM CUSTOMER C, SALES S
WHERE(S.CUST_NO = C.CUST_NO)
ORDER BY C.CUST_NO, C.CUSTOMER');
Query1.Active := True;
end;
{14. Run the application.}
{Example #3: User-defined Alias Configuration}
{This example brings up a input dialog and prompts the user to enter the
directory to which the ALIAS is to be configured to.
The directory, servername, path, database name, and other neccessary Alias
parameters can be read into the application from use of an input dialog or
.INI file.
1. Follow the steps (1-11) in Example #1.
2. Place the following code inside of the TButton's OnClick event.}
procedure TForm1.Buttton1Click(Sender: TObject);
var
NewString: string;
ClickedOK: Boolean;
begin
NewString := 'C:';
ClickedOK := InputQuery('Database Path',
'Path: --> C:DELPHIDEMOSDATA', NewString);
if ClickedOK then
begin
Database1.DatabaseName := 'MyNewAlias';
Database1.DriverName := 'STANDARD';
Database1.Params.Clear;
Database1.Params.Add('Path=' + NewString);
Table1.DatabaseName := 'MyNewAlias';
Table1.TableName := 'CUSTOMER';
Table1.Active := True;
DataSource1.DataSet := Table1;
DBGrid1.DataSource := DataSource1;
end;
end;
//3. Run the Application.
Delphi - .....................................
neoturk: ...Access paradox tables on cd or read-only drives ?...
{This Technical Information document will step through the concepts
regarding accessing Paradox tables which are located on a CD-ROM or
any read-only device.
The Paradox locking scheme requires the existence of a PDOXUSRS.LCK
file to handle its locking logic. This file is generally created at
run-time and resides in the directory which also contains the tables.
However, with a CD-ROM there is not a way to create this file at
run-time on the CD-ROM. The solution is simple, we create this file
and put it on the CD-ROM when the CD is pressed. The following steps
will give you a very simple utility program for creating the
PDOXUSRS.LCK file which you will then copy to the CD-ROM image.}
{1. Starting with a blank project add the following components:} TEdit,
TButton and TDatabase.
{2. In the OnClick event for the button use the following code:}
procedure TForm1.Button1Click(Sender: TObject);
begin
if ChkPath then
Check(DbiAcqPersistTableLock(Database1.Handle,
'PARADOX.DRO', 'PARADOX'));
end;
{3. The ChkPath function is a user defined method of the form. It will
simply check the path entered in the Edit box and make sure it exists.
Here is the function:}
function TForm1.ChkPath: Boolean;
var
s: array[0..100] of char;
begin
if DirectoryExists(Edit1.Text) then
begin
DataBase1.DatabaseName := 'TempDB';
DataBase1.DriverName := 'Standard';
DataBase1.LoginPrompt := False;
DataBase1.Connected := False;
DataBase1.Params.Add('Path=' + Edit1.Text);
DataBase1.Connected := True;
Result := True;
end
else
begin
StrPCopy(s, 'Directory : ' + Edit1.Text + ' Does Not Exist');
Application.MessageBox(s, 'Error!', MB_ICONSTOP);
Result := False;
end;
end;
{ Note: Don't forget to put the function header in the public section
of the form.}
{4. There is one more thing you need to add before compiling, in the
Uses statement at the top of the unit add the following units:}
Delphi 1.0: FileCtrl, DbiProcs, DbiTypes, DbiErrs.Delphi 2.0: FileCtrl, BDE
{When you have compiled and executed the utility program, it will
create two files in the directory you specified. The two files created
are: PDOXUSRS.LCK and PARADOX.LCK.}
{Note: The PARADOX.LCK file is only necessary when accessing Paradox for
DOS tables so you can delete it.}
{5. The only thing left for you to do is copy the remaining file
(PDOXUSRS.LCK) to the CD-ROM image. Of course your tables will be
Read-Only.}
{Note: If you want to clean up this utility for future use, you can
change the text property of the Edit box to be some default directory
and change the Caption property of the Button to be something more
meaningful.}
{Here is the final version of the code:}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, DB, StdCtrls, FileCtrl,
{$IFDEF WIN32}
BDE;
{$ELSE}
DbiProcs, DbiTypes, DbiErrs;
{$ENDIF }
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Database1: TDatabase;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function ChkPath: Boolean;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function TForm1.ChkPath: Boolean;
var
s: array[0..100] of char;
begin
if DirectoryExists(Edit1.Text) then
begin
DataBase1.DatabaseName := 'TempDB';
DataBase1.DriverName := 'Standard';
DataBase1.LoginPrompt := False;
DataBase1.Connected := False;
DataBase1.Params.Add('Path=' + Edit1.Text);
DataBase1.Connected := True;
Result := True;
end
else
begin
StrPCopy(s, 'Directory : ' + Edit1.Text + ' Does Not Exist');
Application.MessageBox(s, 'Error!', MB_ICONSTOP);
Result := False;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if ChkPath then
Check(DbiAcqPersistTableLock(Database1.Handle,
'PARADOX.DRO', 'PARADOX'));
end;
end.
Delphi - .....................................
neoturk: ...Access paradox tables on cd or read-only drives ?...
{This Technical Information document will step through the concepts
regarding accessing Paradox tables which are located on a CD-ROM or
any read-only device.
The Paradox locking scheme requires the existence of a PDOXUSRS.LCK
file to handle its locking logic. This file is generally created at
run-time and resides in the directory which also contains the tables.
However, with a CD-ROM there is not a way to create this file at
run-time on the CD-ROM. The solution is simple, we create this file
and put it on the CD-ROM when the CD is pressed. The following steps
will give you a very simple utility program for creating the
PDOXUSRS.LCK file which you will then copy to the CD-ROM image.}
{1. Starting with a blank project add the following components:} TEdit,
TButton and TDatabase.
{2. In the OnClick event for the button use the following code:}
procedure TForm1.Button1Click(Sender: TObject);
begin
if ChkPath then
Check(DbiAcqPersistTableLock(Database1.Handle,
'PARADOX.DRO', 'PARADOX'));
end;
{3. The ChkPath function is a user defined method of the form. It will
simply check the path entered in the Edit box and make sure it exists.
Here is the function:}
function TForm1.ChkPath: Boolean;
var
s: array[0..100] of char;
begin
if DirectoryExists(Edit1.Text) then
begin
DataBase1.DatabaseName := 'TempDB';
DataBase1.DriverName := 'Standard';
DataBase1.LoginPrompt := False;
DataBase1.Connected := False;
DataBase1.Params.Add('Path=' + Edit1.Text);
DataBase1.Connected := True;
Result := True;
end
else
begin
StrPCopy(s, 'Directory : ' + Edit1.Text + ' Does Not Exist');
Application.MessageBox(s, 'Error!', MB_ICONSTOP);
Result := False;
end;
end;
{ Note: Don't forget to put the function header in the public section
of the form.}
{4. There is one more thing you need to add before compiling, in the
Uses statement at the top of the unit add the following units:}
Delphi 1.0: FileCtrl, DbiProcs, DbiTypes, DbiErrs.Delphi 2.0: FileCtrl, BDE
{When you have compiled and executed the utility program, it will
create two files in the directory you specified. The two files created
are: PDOXUSRS.LCK and PARADOX.LCK.}
{Note: The PARADOX.LCK file is only necessary when accessing Paradox for
DOS tables so you can delete it.}
{5. The only thing left for you to do is copy the remaining file
(PDOXUSRS.LCK) to the CD-ROM image. Of course your tables will be
Read-Only.}
{Note: If you want to clean up this utility for future use, you can
change the text property of the Edit box to be some default directory
and change the Caption property of the Button to be something more
meaningful.}
{Here is the final version of the code:}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, DB, StdCtrls, FileCtrl,
{$IFDEF WIN32}
BDE;
{$ELSE}
DbiProcs, DbiTypes, DbiErrs;
{$ENDIF }
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Database1: TDatabase;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function ChkPath: Boolean;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function TForm1.ChkPath: Boolean;
var
s: array[0..100] of char;
begin
if DirectoryExists(Edit1.Text) then
begin
DataBase1.DatabaseName := 'TempDB';
DataBase1.DriverName := 'Standard';
DataBase1.LoginPrompt := False;
DataBase1.Connected := False;
DataBase1.Params.Add('Path=' + Edit1.Text);
DataBase1.Connected := True;
Result := True;
end
else
begin
StrPCopy(s, 'Directory : ' + Edit1.Text + ' Does Not Exist');
Application.MessageBox(s, 'Error!', MB_ICONSTOP);
Result := False;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if ChkPath then
Check(DbiAcqPersistTableLock(Database1.Handle,
'PARADOX.DRO', 'PARADOX'));
end;
end.
Delphi - .....................................
neoturk: ...Export a tdbgrid to excel without ole ?...
{
Exporting a DBGrid to excel without OLE
I develop software and about 95% of my work deals with databases.
I enjoied the advantages of using Microsoft Excel in my projects
in order to make reports but recently I decided to convert myself
to the free OpenOffice suite.
I faced with the problem of exporting data to Excel without having
Office installed on my computer.
The first solution was to create directly an Excel format compatible file:
this solution is about 50 times faster than the OLE solution but there
is a problem: the output file is not compatible with OpenOffice.
I wanted a solution which was compatible with each "DataSet";
at the same time I wanted to export only the dataset data present in
a DBGrid and not all the "DataSet".
Finally I obtained this solution which satisfied my requirements.
I hope that it will be usefull for you too.
First of all you must import the ADOX type library
which will be used to create the Excel file and its
internal structure: in the Delphi IDE:
1)Project->Import Type Library:
2)Select "Microsoft ADO Ext. for DDL and Security"
3)Uncheck "Generate component wrapper" at the bottom
4)Rename the class names (TTable, TColumn, TIndex, TKey, TGroup, TUser, TCatalog) in
(TXTable, TXColumn, TXIndex, TXKey, TXGroup, TXUser, TXCatalog)
in order to avoid conflicts with the already present TTable component.
5)Select the Unit dir name and press "Create Unit".
It will be created a file named AOX_TLB.
Include ADOX_TLB in the "uses" directive inside the file in which you want
to use ADOX functionality.
That is all. Let's go now with the implementation:
}
unit DBGridExportToExcel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, DB, IniFiles, Buttons, dbgrids, ADOX_TLB, ADODB;
type TScrollEvents = class
BeforeScroll_Event: TDataSetNotifyEvent;
AfterScroll_Event: TDataSetNotifyEvent;
AutoCalcFields_Property: Boolean;
end;
procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
procedure DBGridToExcelADO(DBGrid: TDBGrid; FileName: string; SheetName: string);
implementation
//Support procedures: I made that in order to increase speed in
//the process of scanning large amounts
//of records in a dataset
//we make a call to the "DisableControls" procedure and then disable the "BeforeScroll" and
//"AfterScroll" events and the "AutoCalcFields" property.
procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
begin
with DataSet do
begin
DisableControls;
ScrollEvents := TScrollEvents.Create();
with ScrollEvents do
begin
BeforeScroll_Event := BeforeScroll;
AfterScroll_Event := AfterScroll;
AutoCalcFields_Property := AutoCalcFields;
BeforeScroll := nil;
AfterScroll := nil;
AutoCalcFields := False;
end;
end;
end;
//we make a call to the "EnableControls" procedure and then restore
// the "BeforeScroll" and "AfterScroll" events and the "AutoCalcFields" property.
procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
begin
with DataSet do
begin
EnableControls;
with ScrollEvents do
begin
BeforeScroll := BeforeScroll_Event;
AfterScroll := AfterScroll_Event;
AutoCalcFields := AutoCalcFields_Property;
end;
end;
end;
//This is the procedure which make the work:
procedure DBGridToExcelADO(DBGrid: TDBGrid; FileName: string; SheetName: string);
var
cat: _Catalog;
tbl: _Table;
col: _Column;
i: integer;
ADOConnection: TADOConnection;
ADOQuery: TADOQuery;
ScrollEvents: TScrollEvents;
SavePlace: TBookmark;
begin
//
//WorkBook creation (database)
cat := CoCatalog.Create;
cat._Set_ActiveConnection('Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0');
//WorkSheet creation (table)
tbl := CoTable.Create;
tbl.Set_Name(SheetName);
//Columns creation (fields)
DBGrid.DataSource.DataSet.First;
with DBGrid.Columns do
begin
for i := 0 to Count - 1 do
if Items[i].Visible then
begin
col := nil;
col := CoColumn.Create;
with col do
begin
Set_Name(Items[i].Title.Caption);
Set_Type_(adVarWChar);
end;
//add column to table
tbl.Columns.Append(col, adVarWChar, 20);
end;
end;
//add table to database
cat.Tables.Append(tbl);
col := nil;
tbl := nil;
cat := nil;
//exporting
ADOConnection := TADOConnection.Create(nil);
ADOConnection.LoginPrompt := False;
ADOConnection.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0';
ADOQuery := TADOQuery.Create(nil);
ADOQuery.Connection := ADOConnection;
ADOQuery.SQL.Text := 'Select * from [' + SheetName + '$]';
ADOQuery.Open;
DisableDependencies(DBGrid.DataSource.DataSet, ScrollEvents);
SavePlace := DBGrid.DataSource.DataSet.GetBookmark;
try
with DBGrid.DataSource.DataSet do
begin
First;
while not Eof do
begin
ADOQuery.Append;
with DBGrid.Columns do
begin
ADOQuery.Edit;
for i := 0 to Count - 1 do
if Items[i].Visible then
begin
ADOQuery.FieldByName(Items[i].Title.Caption).AsString := FieldByName(Items[i].FieldName).AsString;
end;
ADOQuery.Post;
end;
Next;
end;
end;
finally
DBGrid.DataSource.DataSet.GotoBookmark(SavePlace);
DBGrid.DataSource.DataSet.FreeBookmark(SavePlace);
EnableDependencies(DBGrid.DataSource.DataSet, ScrollEvents);
ADOQuery.Close;
ADOConnection.Close;
ADOQuery.Free;
ADOConnection.Free;
end;
end;
end.
Delphi - .....................................
neoturk: ...Export a tdbgrid to excel without ole ?...
{
Exporting a DBGrid to excel without OLE
I develop software and about 95% of my work deals with databases.
I enjoied the advantages of using Microsoft Excel in my projects
in order to make reports but recently I decided to convert myself
to the free OpenOffice suite.
I faced with the problem of exporting data to Excel without having
Office installed on my computer.
The first solution was to create directly an Excel format compatible file:
this solution is about 50 times faster than the OLE solution but there
is a problem: the output file is not compatible with OpenOffice.
I wanted a solution which was compatible with each "DataSet";
at the same time I wanted to export only the dataset data present in
a DBGrid and not all the "DataSet".
Finally I obtained this solution which satisfied my requirements.
I hope that it will be usefull for you too.
First of all you must import the ADOX type library
which will be used to create the Excel file and its
internal structure: in the Delphi IDE:
1)Project->Import Type Library:
2)Select "Microsoft ADO Ext. for DDL and Security"
3)Uncheck "Generate component wrapper" at the bottom
4)Rename the class names (TTable, TColumn, TIndex, TKey, TGroup, TUser, TCatalog) in
(TXTable, TXColumn, TXIndex, TXKey, TXGroup, TXUser, TXCatalog)
in order to avoid conflicts with the already present TTable component.
5)Select the Unit dir name and press "Create Unit".
It will be created a file named AOX_TLB.
Include ADOX_TLB in the "uses" directive inside the file in which you want
to use ADOX functionality.
That is all. Let's go now with the implementation:
}
unit DBGridExportToExcel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, DB, IniFiles, Buttons, dbgrids, ADOX_TLB, ADODB;
type TScrollEvents = class
BeforeScroll_Event: TDataSetNotifyEvent;
AfterScroll_Event: TDataSetNotifyEvent;
AutoCalcFields_Property: Boolean;
end;
procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
procedure DBGridToExcelADO(DBGrid: TDBGrid; FileName: string; SheetName: string);
implementation
//Support procedures: I made that in order to increase speed in
//the process of scanning large amounts
//of records in a dataset
//we make a call to the "DisableControls" procedure and then disable the "BeforeScroll" and
//"AfterScroll" events and the "AutoCalcFields" property.
procedure DisableDependencies(DataSet: TDataSet; var ScrollEvents: TScrollEvents);
begin
with DataSet do
begin
DisableControls;
ScrollEvents := TScrollEvents.Create();
with ScrollEvents do
begin
BeforeScroll_Event := BeforeScroll;
AfterScroll_Event := AfterScroll;
AutoCalcFields_Property := AutoCalcFields;
BeforeScroll := nil;
AfterScroll := nil;
AutoCalcFields := False;
end;
end;
end;
//we make a call to the "EnableControls" procedure and then restore
// the "BeforeScroll" and "AfterScroll" events and the "AutoCalcFields" property.
procedure EnableDependencies(DataSet: TDataSet; ScrollEvents: TScrollEvents);
begin
with DataSet do
begin
EnableControls;
with ScrollEvents do
begin
BeforeScroll := BeforeScroll_Event;
AfterScroll := AfterScroll_Event;
AutoCalcFields := AutoCalcFields_Property;
end;
end;
end;
//This is the procedure which make the work:
procedure DBGridToExcelADO(DBGrid: TDBGrid; FileName: string; SheetName: string);
var
cat: _Catalog;
tbl: _Table;
col: _Column;
i: integer;
ADOConnection: TADOConnection;
ADOQuery: TADOQuery;
ScrollEvents: TScrollEvents;
SavePlace: TBookmark;
begin
//
//WorkBook creation (database)
cat := CoCatalog.Create;
cat._Set_ActiveConnection('Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0');
//WorkSheet creation (table)
tbl := CoTable.Create;
tbl.Set_Name(SheetName);
//Columns creation (fields)
DBGrid.DataSource.DataSet.First;
with DBGrid.Columns do
begin
for i := 0 to Count - 1 do
if Items[i].Visible then
begin
col := nil;
col := CoColumn.Create;
with col do
begin
Set_Name(Items[i].Title.Caption);
Set_Type_(adVarWChar);
end;
//add column to table
tbl.Columns.Append(col, adVarWChar, 20);
end;
end;
//add table to database
cat.Tables.Append(tbl);
col := nil;
tbl := nil;
cat := nil;
//exporting
ADOConnection := TADOConnection.Create(nil);
ADOConnection.LoginPrompt := False;
ADOConnection.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0; Data Source=' + FileName + ';Extended Properties=Excel 8.0';
ADOQuery := TADOQuery.Create(nil);
ADOQuery.Connection := ADOConnection;
ADOQuery.SQL.Text := 'Select * from [' + SheetName + '$]';
ADOQuery.Open;
DisableDependencies(DBGrid.DataSource.DataSet, ScrollEvents);
SavePlace := DBGrid.DataSource.DataSet.GetBookmark;
try
with DBGrid.DataSource.DataSet do
begin
First;
while not Eof do
begin
ADOQuery.Append;
with DBGrid.Columns do
begin
ADOQuery.Edit;
for i := 0 to Count - 1 do
if Items[i].Visible then
begin
ADOQuery.FieldByName(Items[i].Title.Caption).AsString := FieldByName(Items[i].FieldName).AsString;
end;
ADOQuery.Post;
end;
Next;
end;
end;
finally
DBGrid.DataSource.DataSet.GotoBookmark(SavePlace);
DBGrid.DataSource.DataSet.FreeBookmark(SavePlace);
EnableDependencies(DBGrid.DataSource.DataSet, ScrollEvents);
ADOQuery.Close;
ADOConnection.Close;
ADOQuery.Free;
ADOConnection.Free;
end;
end;
end.
Delphi - .....................................
neoturk: ...Retrieve all database tables with ado ?...
//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;
Delphi - .....................................
neoturk: ...Retrieve all database tables with ado ?...
//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;
Delphi - .....................................
neoturk: ...Export ado tables into various formats ?...
{
Exporting ADO tables into various formats
In this article I want to present a component I built in order to
supply exporting features to the ADOTable component. ADO supplies
an extended SQL syntax that allows exporting of data into various
formats. I took into consideration the following formats:
1)Excel
2)Html
3)Paradox
4)Dbase
5)Text
You can see all supported output formats in the registry:
"HKEY_LOCAL_MACHINESoftwareMicrosoftJet4.0ISAM formats"
This is the complete source of my component }
unit ExportADOTable;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, ADODB;
type
TExportADOTable = class(TADOTable)
private
{ Private declarations }
//TADOCommand component used to execute the SQL exporting commands
FADOCommand: TADOCommand;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
//Export procedures
//"FiledNames" is a comma separated list of the names of the fields you want to export
//"FileName" is the name of the output file (including the complete path)
//if the dataset is filtered (Filtered = true and Filter <> ''), then I append
//the filter string to the sql command in the "where" directive
//if the dataset is sorted (Sort <> '') then I append the sort string to the sql command in the
//"order by" directive
procedure ExportToExcel(FieldNames: string; FileName: string;
SheetName: string; IsamFormat: string);
procedure ExportToHtml(FieldNames: string; FileName: string);
procedure ExportToParadox(FieldNames: string; FileName: string; IsamFormat: string);
procedure ExportToDbase(FieldNames: string; FileName: string; IsamFormat: string);
procedure ExportToTxt(FieldNames: string; FileName: string);
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Carlo Pasolini', [TExportADOTable]);
end;
constructor TExportADOTable.Create(AOwner: TComponent);
begin
inherited;
FADOCommand := TADOCommand.Create(Self);
end;
procedure TExportADOTable.ExportToExcel(FieldNames: string; FileName: string;
SheetName: string; IsamFormat: string);
begin
{IsamFormat values
Excel 3.0
Excel 4.0
Excel 5.0
Excel 8.0
}
if not Active then
Exit;
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
SheetName + ']' + ' IN ' + '"' + FileName + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
procedure TExportADOTable.ExportToHtml(FieldNames: string; FileName: string);
var
IsamFormat: string;
begin
if not Active then
Exit;
IsamFormat := 'HTML Export';
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
ExtractFileName(FileName) + ']' +
' IN ' + '"' + ExtractFilePath(FileName) + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
procedure TExportADOTable.ExportToParadox(FieldNames: string;
FileName: string; IsamFormat: string);
begin
{IsamFormat values
Paradox 3.X
Paradox 4.X
Paradox 5.X
Paradox 7.X
}
if not Active then
Exit;
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
ExtractFileName(FileName) + ']' +
' IN ' + '"' + ExtractFilePath(FileName) + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
procedure TExportADOTable.ExportToDbase(FieldNames: string; FileName: string;
IsamFormat: string);
begin
{IsamFormat values
dBase III
dBase IV
dBase 5.0
}
if not Active then
Exit;
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
ExtractFileName(FileName) + ']' +
' IN ' + '"' + ExtractFilePath(FileName) + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
procedure TExportADOTable.ExportToTxt(FieldNames: string; FileName: string);
var
IsamFormat: string;
begin
if not Active then
Exit;
IsamFormat := 'Text';
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
ExtractFileName(FileName) + ']' +
' IN ' + '"' + ExtractFilePath(FileName) + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
end.
{
Note that you can use an already existing database as destination but not an already existing
table in the database itself: if you specify an already exixting table you will receive
an error message. You might insert a verification code inside every exporting procedure of my
component, before the execution of the sql exporting command, in order to send a request of
deleting the already present table or aborting the exporting process.
Delphi - .....................................
neoturk: ...Export ado tables into various formats ?...
{
Exporting ADO tables into various formats
In this article I want to present a component I built in order to
supply exporting features to the ADOTable component. ADO supplies
an extended SQL syntax that allows exporting of data into various
formats. I took into consideration the following formats:
1)Excel
2)Html
3)Paradox
4)Dbase
5)Text
You can see all supported output formats in the registry:
"HKEY_LOCAL_MACHINESoftwareMicrosoftJet4.0ISAM formats"
This is the complete source of my component }
unit ExportADOTable;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, ADODB;
type
TExportADOTable = class(TADOTable)
private
{ Private declarations }
//TADOCommand component used to execute the SQL exporting commands
FADOCommand: TADOCommand;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
//Export procedures
//"FiledNames" is a comma separated list of the names of the fields you want to export
//"FileName" is the name of the output file (including the complete path)
//if the dataset is filtered (Filtered = true and Filter <> ''), then I append
//the filter string to the sql command in the "where" directive
//if the dataset is sorted (Sort <> '') then I append the sort string to the sql command in the
//"order by" directive
procedure ExportToExcel(FieldNames: string; FileName: string;
SheetName: string; IsamFormat: string);
procedure ExportToHtml(FieldNames: string; FileName: string);
procedure ExportToParadox(FieldNames: string; FileName: string; IsamFormat: string);
procedure ExportToDbase(FieldNames: string; FileName: string; IsamFormat: string);
procedure ExportToTxt(FieldNames: string; FileName: string);
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Carlo Pasolini', [TExportADOTable]);
end;
constructor TExportADOTable.Create(AOwner: TComponent);
begin
inherited;
FADOCommand := TADOCommand.Create(Self);
end;
procedure TExportADOTable.ExportToExcel(FieldNames: string; FileName: string;
SheetName: string; IsamFormat: string);
begin
{IsamFormat values
Excel 3.0
Excel 4.0
Excel 5.0
Excel 8.0
}
if not Active then
Exit;
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
SheetName + ']' + ' IN ' + '"' + FileName + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
procedure TExportADOTable.ExportToHtml(FieldNames: string; FileName: string);
var
IsamFormat: string;
begin
if not Active then
Exit;
IsamFormat := 'HTML Export';
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
ExtractFileName(FileName) + ']' +
' IN ' + '"' + ExtractFilePath(FileName) + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
procedure TExportADOTable.ExportToParadox(FieldNames: string;
FileName: string; IsamFormat: string);
begin
{IsamFormat values
Paradox 3.X
Paradox 4.X
Paradox 5.X
Paradox 7.X
}
if not Active then
Exit;
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
ExtractFileName(FileName) + ']' +
' IN ' + '"' + ExtractFilePath(FileName) + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
procedure TExportADOTable.ExportToDbase(FieldNames: string; FileName: string;
IsamFormat: string);
begin
{IsamFormat values
dBase III
dBase IV
dBase 5.0
}
if not Active then
Exit;
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
ExtractFileName(FileName) + ']' +
' IN ' + '"' + ExtractFilePath(FileName) + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
procedure TExportADOTable.ExportToTxt(FieldNames: string; FileName: string);
var
IsamFormat: string;
begin
if not Active then
Exit;
IsamFormat := 'Text';
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
ExtractFileName(FileName) + ']' +
' IN ' + '"' + ExtractFilePath(FileName) + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
end.
{
Note that you can use an already existing database as destination but not an already existing
table in the database itself: if you specify an already exixting table you will receive
an error message. You might insert a verification code inside every exporting procedure of my
component, before the execution of the sql exporting command, in order to send a request of
deleting the already present table or aborting the exporting process.
Delphi - .....................................
neoturk: ...Adapt datetime values for different sql-server formats ?...
{
If you work with different (MS-)SQL-Server, you have sometimes the
problem what the date value is in the correct format.
}
function TForm1.GetSQLDateTimeFormat(UDL: string): string;
begin
Screen.Cursor := crSQLWait;
if ADOConnection1.Connected then ADOConnection1.Close;
ADOConnection1.ConnectionString := 'FILE NAME=' + UDL;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('sp_helplanguage @@LANGUAGE');
Application.ProcessMessages;
try
try
ADOQuery1.Open;
except
on E: Exception do MessageBox(Handle,
PChar('Die Abfrage konnte nicht geöffnet werden:' + #13#10 + #13#10 + E.Message),
PChar('Fehler!'), 16);
end;
if (ADOQuery1.Active) and (ADOQuery1.RecordCount > 0) then
Result := ADOQuery1.FieldByName('dateformat').AsString;
finally
Screen.Cursor := crDefault;
end;
end;
function DateTimeToSQLDateTimeString(Data: TDateTime; Format: string;
OnlyDate: Boolean = True): string;
var
y, m, d, h, mm, s, ms: Word;
begin
DecodeDate(Data, y, m, d);
DecodeTime(Data, h, mm, s, ms);
if Format = 'dmy' then
Result := IntToStr(d) + '-' + IntToStr(m) + '-' + IntToStr(y)
else if Format = 'ymd' then
Result := IntToStr(y) + '-' + IntToStr(m) + '-' + IntToStr(d)
else if Format = 'ydm' then
Result := IntToStr(y) + '-' + IntToStr(d) + '-' + IntToStr(m)
else if Format = 'myd' then
Result := IntToStr(m) + '-' + IntToStr(y) + '-' + IntToStr(d)
else if Format = 'dym' then
Result := IntToStr(d) + '-' + IntToStr(y) + '-' + IntToStr(m)
else
Result := IntToStr(m) + '-' + IntToStr(d) + '-' + IntToStr(y); //mdy: ; //US
if not OnlyDate then
Result := Result + ' ' + IntToStr(h) + ':' + IntToStr(mm) + ':' + IntToStr(s);
end;
//Example:
//Beispiel:
procedure ConvertSQLDateTime;
begin
ShowMessage(DateTimeToSQLDateTimeString(now, GetSQLLanguage('C:DBEngl.udl')));
end;
Delphi - .....................................
neoturk: ...Adapt datetime values for different sql-server formats ?...
{
If you work with different (MS-)SQL-Server, you have sometimes the
problem what the date value is in the correct format.
}
function TForm1.GetSQLDateTimeFormat(UDL: string): string;
begin
Screen.Cursor := crSQLWait;
if ADOConnection1.Connected then ADOConnection1.Close;
ADOConnection1.ConnectionString := 'FILE NAME=' + UDL;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('sp_helplanguage @@LANGUAGE');
Application.ProcessMessages;
try
try
ADOQuery1.Open;
except
on E: Exception do MessageBox(Handle,
PChar('Die Abfrage konnte nicht geöffnet werden:' + #13#10 + #13#10 + E.Message),
PChar('Fehler!'), 16);
end;
if (ADOQuery1.Active) and (ADOQuery1.RecordCount > 0) then
Result := ADOQuery1.FieldByName('dateformat').AsString;
finally
Screen.Cursor := crDefault;
end;
end;
function DateTimeToSQLDateTimeString(Data: TDateTime; Format: string;
OnlyDate: Boolean = True): string;
var
y, m, d, h, mm, s, ms: Word;
begin
DecodeDate(Data, y, m, d);
DecodeTime(Data, h, mm, s, ms);
if Format = 'dmy' then
Result := IntToStr(d) + '-' + IntToStr(m) + '-' + IntToStr(y)
else if Format = 'ymd' then
Result := IntToStr(y) + '-' + IntToStr(m) + '-' + IntToStr(d)
else if Format = 'ydm' then
Result := IntToStr(y) + '-' + IntToStr(d) + '-' + IntToStr(m)
else if Format = 'myd' then
Result := IntToStr(m) + '-' + IntToStr(y) + '-' + IntToStr(d)
else if Format = 'dym' then
Result := IntToStr(d) + '-' + IntToStr(y) + '-' + IntToStr(m)
else
Result := IntToStr(m) + '-' + IntToStr(d) + '-' + IntToStr(y); //mdy: ; //US
if not OnlyDate then
Result := Result + ' ' + IntToStr(h) + ':' + IntToStr(mm) + ':' + IntToStr(s);
end;
//Example:
//Beispiel:
procedure ConvertSQLDateTime;
begin
ShowMessage(DateTimeToSQLDateTimeString(now, GetSQLLanguage('C:DBEngl.udl')));
end;
