Okay. Here goes...
I encapsulated the capability to inspect local tables (dBASE, Paradox,
FoxPro) to retrieve field definition information into a component. This
component is called TBDETableTool and is defined in the unit
BDETableTool.pas (posted as a separate message in this thread).
Field definitions are retrieved into a TCollection descendent class called
TFieldList, defined in FldList.pas (also posted separately). This
collection stores individual field definitions in descendents of
TCollectionItem called TFieldItem. The reason for using this intermediate
storage container is so that the table could be parsed once and then that
information used for various other purposes (such as composing SQL or
filling TFieldDef objects) without rereading the table each time.
The field definitions are also stored in the TBDETableTool.SQL property.
This makes it easy to assign the value to a pre-existing string list
object, like the Lines property of a TMemo.
Using TBDETableTool is a matter of:
1. Creating an instance of TBDETableTool.
2. Setting its Table property to point to a TTable component
representing the table to inspect. The act of setting this
property triggers the table parsing mechanism.
3. Read the TBDETableTool.SQL property or assign its value to
another string list object.
For example:
var
BDETableTool1: TBDETableTool;
begin
BDETableTool1 := TBDETableTool(Self);
try
Table1.Close;
Table1.DatabaseName := 'DBDEMOS';
Table1.TableName := 'Customer.db';
end;
BDETableTool1.Table := Table1;
Memo1.Lines.Clear;
Memo1.Lines.Assign(BDETableTool1.SQL);
finally
if Assigned(BDETableTool1) then BDETableTool1.Free;
end;
end;
Automatic parsing of the table is handled by the setter function for the
TBDETableTool.Table property, TBDETableTool.SetTable (shown below). It does
some basic property housekeeping and calls the methods GetTableInfo,
ParseDataSet, and GenSQL.
procedure TBDETableTool.SetTable(Table: TTable);
begin
if Assigned(Table) then begin
FTable := Table;
FTableWasActive := FTable.Active;
if not FTable.Active then FTable.Active := True;
GetTableInfo;
ParseDataset;
GenSQL;
end;
end;
The GetTableInfo method uses the BDE API function DbiGetCursorProps to get
various table properties. This information does not part of the process of
translating field definitions to SQL, but is stored for other unrelated
purposes.
procedure TBDETableTool.GetTableInfo;
var
Props: CURProps;
rslt: DBIResult;
begin
rslt := DbiGetCursorProps(FTable.Handle, Props);
if (rslt = DBIERR_NONE) then begin
with TableInfo do begin
TableName := Props.szName;
TableType := Props.szTableType;
Fields := Props.iFields;
RecBufSize := Props.iRecBufSize;
Indexes := Props.iIndexes;
ValChecks := Props.iValChecks;
RIntChecks := Props.iRefIntChecks;
Level := Props.iTblLevel;
LangDrvr := Props.szLangDriver;
end;
end
else
HandleError('The specified cursor handle is invalid or NULL.');
end;
The ParseDataSet method inspects the table to retrieve field definitions.
It does this using the BDE API function DbiGetFieldDescs. ParseDataset
traverses the table's structure, sequentially visiting each field
definition. For each new field definition, a TFieldItem is created (with
TFieldList.Add) and the various FLDDesc fields used for the values in the
TFieldItem.
procedure TBDETableTool.ParseDataset;
var
i: Integer;
curProp: CURProps;
pfldDes, pCurFld: pFLDDesc;
MemSize: Integer;
begin
FieldDefs.Clear;
DbiGetCursorProps(FTable.Handle, curProp);
MemSize := curProp.iFields * SizeOf(FLDDesc);
pfldDes := AllocMem(MemSize);
try
pCurFld := pfldDes;
Check(DbiGetFieldDescs(FTable.Handle, pfldDes));
i := 0;
while (i < curProp.iFields) do begin
FieldDefs.Add(pCurFld^.szName, pCurFld^.iFldType, ftString,
pCurFld^.iSubType, pCurFld^.iUnits2, pCurFld^.iUnits1);
inc(pCurFld);
inc(i);
end;
finally
FreeMem(pfldDes, MemSize);
end;
end;
Finally, the GenSQL method translates the field definitions in the
TFieldList into a valid local SQL statement. It does this using a few
internal helper methods (not normally used or seen by the component's
end-user): FormatTableName, FormatFieldName, FormatSQLDataType, and
AddPrimaryIndex. FormatTableName and FormatFieldName are mostly cosmetic,
formatting the table name and the names of individual fields. They are
affected by such TBDETableTool properties as ShowTable, ShowExt,
QuoteTables, and QuoteFields (described later). In this method, the
TBDETableTool.IncludeRemarks determines whether a comments section is
inserted at the top of the SQL statement giving additional information
about the table (some of this information coming from the GetTableInfo
method).
procedure TBDETableTool.GenSQL;
var
TempStr: String;
i: Integer;
begin
with FSQL do begin
Clear;
{ only fill SQL if ParseData made field definitions }
if (FieldDefs.Count > 0) then begin
if IncludeRemarks then begin
Add('/*');
Add(' Table name: ' + FormatTableName);
Add(' Table type: ' + TableInfo.TableType);
Add(' Table level: ' + IntToStr(TableInfo.Level));
Add(' Language driver: ' + TableInfo.Langdrvr);
Add(' SQL generated: ' + DateToStr(Date) + ' ' +
FormatDateTime('hh:nn:ssam/pm', Now));
Add('*/');
Add('');
end;
Add('CREATE TABLE ' + FormatTableName);
Add('(');
for i := 0 to (FieldDefs.Count - 1) do begin
TempStr := '';
TempStr := TempStr +
FormatFieldName(FieldDefs[i].Name) + ' ' +
FormatSQLDataType(FieldDefs[i].FieldType,
FieldDefs[i].SubType, FieldDefs[i].Precision,
FieldDefs[i].Scale);
if (i < (FieldDefs.Count - 1)) then
TempStr := TempStr + ',';
{ Just in case a field type cannot be recognized }
if (Pos('unknown', TempStr) > 0) then
TempStr := TempStr + ' [' +
'T: ' + IntToStr(FieldDefs[i].FieldType) + ', ' +
'S: ' + IntToStr(FieldDefs[i].SubType) + ', ' +
'U1: ' + IntToStr(FieldDefs[i].Precision) + ', ' +
'U2: ' + IntToStr(FieldDefs[i].Scale) + ']';
SQL.Add(' ' + TempStr);
end;
AddPrimaryIndex;
Add(')');
Add('');
end;
end;
end;
The FormatSQLDataType method is an internal helper routine that translates
from BDE native field types to local SQL field types. The AType property of
the TFieldItem properties store this native BDE data type and this field is
used as the basis for the translation process of this method. This
translation process also handles the scale and precision for numeric type
fields and the size of Memo fields.
function TBDETableTool.FormatSQLDataType(AType, ASubType, APrecision,
AScale: Word): String;
var
rslt: String;
begin
case AType of
fldZString: rslt := 'CHAR';
fldDATE: rslt := 'DATE';
fldBLOB: rslt := 'BLOB';
fldBOOL: rslt := 'BOOLEAN';
fldINT16: rslt := 'SMALLINT';
fldINT32: begin
case ASubType of
0: rslt := 'INTEGER';
fldstAUTOINC: rslt := 'AUTOINC';
end;
end;
fldFLOAT: begin
case ASubType of
0: rslt := 'FLOAT';
fldstMONEY: rslt := 'MONEY';
end;
end;
// fldBCD: rslt := 'BCD'; { not supported in local SQL }
fldBYTES: rslt := 'BYTES';
fldTIME: rslt := 'TIME';
fldTIMESTAMP: rslt := 'TIMESTAMP';
else
rslt := 'unknown';
end;
case AType of
{ need scale and precision }
fldFLOAT: begin
if not (TableInfo.TableType = 'PARADOX') then begin
rslt := rslt + '(' + IntToStr(APrecision) + ', ' +
IntToStr(AScale) + ')';
end;
end;
{ need size only }
fldZString, fldBYTES: begin
rslt := rslt + '(' + IntToStr(AScale) + ')';
end;
{ BLOB & memo need size and BLOB type }
fldBLOB: begin
rslt := rslt + '(' + IntToStr(AScale) + ', ' +
GetBlobType(ASubType) + ')'
end;
else
rslt := rslt {+ GetSQLFieldName(FType, SubType)};
end;
Result := rslt;
end;
(I wrote this component some time ago, before learning how to use the
information provided by the BDE API function DbiOpenFieldTypesList to let
the BDE provide the right SQL field type tokens based on indicators
retrieved using DbiGetFieldDescs. I had planned to update this component to
use this appoach, but had not gotten to it as of this writing.)
The AddPrimaryIndex method formulates the line to add a primary index to
the new table -- if one existed in the old. This was necessary because in
local SQL, primary indexes need to be created as part of the CREATE TABLE
statement, not the CREATE INDEX statement. (Incidentally, no provision has
been made in this component to migrate secondary indexes. It was a planed
future feature, but not yet implemented. As it would require a separate
statement for CREATE INDEX, handling it would require a number of added
properties and methods.)
procedure TBDETableTool.AddPrimaryIndex;
var
rslt, Flds: String;
i: Integer;
begin
FTable.IndexDefs.Update;
if (FTable.IndexDefs.Count > 0) then begin
Flds := '';
i := 0;
for i := 0 to (FTable.IndexDefs.Count - 1) do begin
if (ixPrimary in FTable.IndexDefs[i].Options) and
(Length(FTable.IndexDefs[i].Fields) > 0) then begin
Flds := KillSemiColons(FTable.IndexDefs[i].Fields);
Flds := FormatFieldName(Flds);
rslt := ' PRIMARY KEY (' + Flds + ')';
...
read more »
