Board index » delphi » Problem creating new database as DBase IV

Problem creating new database as DBase IV

I have a program that needs to create a new table from an existing table
shell at run time. The existing table is of DBase IV type, but the program
creates the new table as a DBase for Windows type. This is causing prblems
with my Numeric fields (Database Desktop doesn't see them as type 'N', and
no length/dec. pos. is shown).

Does any one know of a way to create a true copy of a table w/ index? Is it
proper to just do a file copy?

My code:
function TfrmMain.MakeNewDBF( sDBFName, sFromPath, sToPath : string ) :
boolean;
var
  FromTable, ToTable : ttable;
  i : integer;
begin
  result := True;
  try
    try
      FromTable := ttable.Create( nil );
      with FromTable do
      begin
        TableName := sDBFName;
        DatabaseName := sFromPath;
        Open;
        IndexDefs.Update;
      end; //with
    except
      on E : Exception do
      begin
        WriteLog( '*ERROR*', 'Could not use ' + sDBFName + ' file: ' +
E.Message );
        result := False;
      end; //on
    end; //try
    if FromTable.Active then
    try
      ToTable := ttable.Create( nil );
      with ToTable do
      begin
        TableName := sDBFName;
        DatabaseName := sToPath;
        FieldDefs := FromTable.FieldDefs;
        TableType := FromTable.TableType;
        CreateTable;
        for i := 0 to FromTable.IndexDefs.Count - 1 do
          if FromTable.IndexDefs.Items[i].Fields = '' then
            AddIndex( FromTable.IndexDefs.Items[i].Name,
FromTable.IndexDefs.Items[i].Expression,
FromTable.IndexDefs.Items[i].Options )
          else
            AddIndex( FromTable.IndexDefs.Items[i].Name,
FromTable.IndexDefs.Items[i].Fields, FromTable.IndexDefs.Items[i].Options
);
      end; //with
    except
      on E : Exception do
      begin
        WriteLog( '*ERROR*', 'Could not create ' + sDBFName + ' file: ' +
E.Message );
        result := False;
      end; //on
    end; //try
  finally
    FromTable.Close;
    FromTable.Free;
    ToTable.Close;
    ToTable.Free;
  end; //try
end;

 

Re:Problem creating new database as DBase IV


Quote
On Thu, 03 Feb 2000 13:53:49 GMT, "system04" <j...@nn.net> wrote:
>I have a program that needs to create a new table from an existing table
>shell at run time. The existing table is of DBase IV type, but the program
>creates the new table as a DBase for Windows type. This is causing prblems
>with my Numeric fields (Database Desktop doesn't see them as type 'N', and
>no length/dec. pos. is shown).

>Does any one know of a way to create a true copy of a table w/ index? Is it
>proper to just do a file copy?

[...]

When you use the TFieldDef field definitions in one dataset component's
FieldDefs property as the basis for a new table's definition, you rely on
Delphi's translations of the TFieldType values to native BDE field types.
The actual field type created will be dependent some on the new table's
level and on the version of the BDE used.

But if you want strict control over the data types of the new columns,
regardless of the above factors, you would need to create the new table
using either the BDE API function DbiCreateTable or a local SQL statement.
The BDE provides facilities through which you can inspect the structure of
one local table to get the definition for each field, with the data type in
native BDE form and never subject to the vagaries of translation. With
these field definitions, you can either compose new field definitions for
use with the function DbiCreateTable or in constructing a local SQL
statement using CREATE TABLE.

I have done the latter, coding a means for creating a local SQL statement
from BDE-specific field definitions. I can post that code here in the
newsgroup if you think you would find it useful.

_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
Steve Koterski              "Health nuts are going to feel stupid someday,
Felton, CA                  lying in hospitals dying of nothing."
                                                              -- Redd Foxx

Re:Problem creating new database as DBase IV


On Thu, 03 Feb 2000 16:51:15 GMT, koter...@NOSPAMgte.net (Steve

Quote
Koterski) wrote:
>these field definitions, you can either compose new field definitions for
>use with the function DbiCreateTable or in constructing a local SQL
>statement using CREATE TABLE.

>I have done the latter, coding a means for creating a local SQL statement
>from BDE-specific field definitions. I can post that code here in the
>newsgroup if you think you would find it useful.

Hi Steve,
I think your code would be very instructive, please post it.
Thank you
Johan Smit

Re:Problem creating new database as DBase IV


Quote
On Sat, 05 Feb 2000 04:40:36 GMT, smi...@mweb.co.za (Johan Smit) wrote:

[...]

Quote
>I think your code would be very instructive, please post it.

Okay. In the next couple days, I will try to organize it with explanations
of the routines. I will also post (as separate messages in this thread) the
units used, in their entirely. (There are three units defining custom
components and one in which all is implemented.)

_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
Steve Koterski              "Health nuts are going to feel stupid someday,
Felton, CA                  lying in hospitals dying of nothing."
                                                              -- Redd Foxx

Re:Problem creating new database as DBase IV


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 »

Re:Problem creating new database as DBase IV


unit FldList;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, BDE, DB, DBTables;

type

  { TFieldItem }
  TFieldItem = class(TCollectionItem)
  private
    FName: String;
    FFieldType: Word;
    DelphiFieldType: TFieldType;
    FSubType: Word;
    FPrecision: Word;
    FScale: Word;
  protected
  public
    procedure Assign(Source: TPersistent);
    property Name: String read FName write FName;
    property FieldType: Word read FFieldType write FFieldType;
    property SubType: Word read FSubType write FSubType;
    property Precision: Word read FPrecision write FPrecision;
    property Scale: Word read FScale write FScale;
  published
  end;

  { TFieldList }
  TFieldList = class(TCollection)
  private
    FOwner: TPersistent;
    function GetItem(Index: Integer): TFieldItem;
    procedure SetItem(Index: Integer; Value: TFieldItem);
  protected
  public
    constructor Create(AOwner: TPersistent);
    destructor Destroy; override;
    procedure Add(AName: String; AFieldType: Word;
      ADelphiFieldType: TFieldType; ASubType, APrecision, AScale: Word);
    procedure Clear;
    property Items[Index: Integer]: TFieldItem read GetItem write SetItem;
default;
  published
  end;

implementation

{ TFieldItem }

procedure TFieldItem.Assign(Source: TPersistent);
begin
  Name := TFieldItem(Source).Name;
  FieldType := TFieldItem(Source).FieldType;
  DelphiFieldType := TFieldItem(Source).DelphiFieldType;
  SubType := TFieldItem(Source).SubType;
  Precision := TFieldItem(Source).Precision;
  Scale := TFieldItem(Source).Scale;
end;

{ TFieldList }

constructor TFieldList.Create(AOwner: TPersistent);
begin
  FOwner := AOwner;
  inherited Create(TFieldItem);
end;

destructor TFieldList.Destroy;
begin
  while Count > 0 do
    if Assigned(Items[Count - 1]) then Items[Count - 1].Free;
end;

function TFieldList.GetItem(Index: Integer): TFieldItem;
begin
  Result := TFieldItem(inherited GetItem(Index));
end;

procedure TFieldList.SetItem(Index: Integer; Value: TFieldItem);
begin
  inherited SetItem(Index, TCollectionItem(Value));
end;

procedure TFieldList.Add(AName: String; AFieldType: Word;
  ADelphiFieldType: TFieldType; ASubType, APrecision, AScale: Word);
begin
  with TFieldItem.Create(Self) do begin
    Name := AName;
    FieldType := AFieldType;
    DelphiFieldType := ADelphiFieldType;
    SubType := ASubType;
    Precision := APrecision;
    Scale := AScale;
  end;
end;

procedure TFieldList.Clear;
begin
  while Count > 0 do
    if Assigned(Items[Count - 1]) then Items[Count - 1].Free;
end;

end.

Re:Problem creating new database as DBase IV


unit BDETableTool;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, BDE, DB, DBTables, FldList;

type

  TTableInfo = record
    TableName: String;
    TableType: String;
    Fields: Integer;
    RecBufSize: Integer;
    Indexes: Integer;
    ValChecks: Integer;
    RIntChecks: Integer;
    Level: Byte;
    LangDrvr: String;
  end;

  { TBDETableTool }
  TBDETableTool = class(TComponent)
  private
    { Private declarations }
    FSQL: TStrings;
    FTable: TTable;
    FTableWasActive: Boolean;
    FIncludeRemarks: Boolean;
    FShowExt: Boolean;
    FShowTable: Boolean;
    FQuoteFields: Boolean;
    FQuoteTables: Boolean;
    FFieldDefs: TFieldList;
    FTableInfo: TTableInfo;
    procedure SetTable(Table: TTable);
    procedure GetTableInfo;
    function GetBlobType(ASubType: Word): String;
    procedure AddPrimaryIndex;
    function KillSemiColons(S: String): String;
    procedure GenSQL;
    procedure ParseDataset;
    function FormatFieldName(FieldName: String): String;
    function FormatTableName: String;
    function FormatSQLDataType(AType, ASubType, APrecision,
      AScale: Word): String;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SaveToFile(FileName: String); overload;
    procedure SaveToFile; overload;
    procedure HandleError(Msg: String);
    procedure ShowTableInfo(List: TStrings);
    property FieldDefs: TFieldList read FFieldDefs;
  published
    { Published declarations }
    property SQL: TStrings read FSQL;
    property Table: TTable read FTable write SetTable;
    property IncludeRemarks: Boolean read FIncludeRemarks
      write FIncludeRemarks;
    property ShowExt: Boolean read FShowExt write FShowExt;
    property ShowTable: Boolean read FShowTable write FShowTable;
    property QuoteFields: Boolean read FQuoteFields write FQuoteFields;
    property QuoteTables: Boolean read FQuoteTables write FQuoteTables;
    property TableInfo: TTableInfo read FTableInfo;
  end;

implementation

{ TBDETableTool }

constructor TBDETableTool.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSQL := TStringList.Create;
  FFieldDefs := TFieldList.Create(AOwner);
  ShowExt := True;
  ShowTable := True;
  QuoteFields := True;
  QuoteTables := True;
  IncludeRemarks := False;
  with TableInfo do begin
    TableName := '';
    TableType := '';
    Fields := 0;
    RecBufSize := 0;
    Indexes := 0;
    ValChecks := 0;
    RIntChecks := 0;
    Level := 0;
    LangDrvr := '';
  end;
end;

destructor TBDETableTool.Destroy;
begin
  Destroying;
  if Assigned(FTable) then FTable.Active := FTableWasActive;
  if Assigned(SQL) then SQL.Free;
  if Assigned(FFieldDefs) then FFieldDefs.Free;
  inherited Destroy;
end;

procedure TBDETableTool.HandleError(Msg: String);
begin
  raise Exception.CreateFmt(
    'BDE Tools exception: ', [Msg]
    );
end;

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;

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;

function TBDETableTool.FormatTableName: String;
var
  rslt: String;
begin
  rslt := TableInfo.TableName;
  if FShowExt then
    if (TableInfo.TableType = 'PARADOX') then
      rslt := rslt + '.db'
    else if (TableInfo.TableType = 'DBASE') or
      (TableInfo.TableType = 'FOXPRO') then
      rslt := rslt + '.dbf';
  if FQuoteTables then
    rslt := '"' + rslt + '"';
  Result := rslt;
end;

function TBDETableTool.FormatFieldName(FieldName: String): String;
var
  SL: TStrings;
  i: Integer;
  rslt: String;
begin
  rslt := '';
  { handle multi-field list }
  if (Pos(',', FieldName) > 0) then begin
    SL := TStringList.Create;
    try
      SL.CommaText := FieldName;
      for i := 0 to (SL.Count - 1) do begin
        rslt := rslt + ',' + FormatFieldName(SL[i]);
      end;
      Delete(rslt, 1, 1);
    finally
      SL.Free;
    end;
  end
  { handle single-field for index }
  else begin
    rslt := FieldName;
    if FQuoteFields then
      rslt := '"' + rslt + '"';
    if FShowTable then
      rslt := FormatTableName + '.' + rslt;
  end;
  Result := rslt;
end;

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;

function TBDETableTool.GetBlobType(ASubType: Word): String;
var
  rslt: String;
begin
  rslt := '';
    case ASubType of
      fldstMEMO: rslt := '1'; { Memo }
      fldstBINARY, fldstTYPEDBINARY: rslt := '2'; { Binary }
      fldstFMTMEMO: rslt := '3'; { Formatted Memo }
      fldstOLEOBJ, fldstDBSOLEOBJ: rslt := '4'; { OLE }
      fldstGRAPHIC: rslt := '5'; { Graphic (Pdox) }
    end;
  Result := rslt;
end;

function TBDETableTool.KillSemiColons(S: String): String;
var
  i: Word;
  x: String;
begin
  x := S;
  for i := 1 to Length(x) do
    if (x[i] = ';') then
      x[i] := ',';
  Result := x;
end;

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 + ')';
        SQL[SQL.Count - 1] := SQL[SQL.Count - 1] + ',';
        SQL.Add(rslt);
        Break;
      end;
    end;
  end;
end;

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 + ',';
        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;

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;

procedure TBDETableTool.SaveToFile(FileName: String);
begin
  if (Length(FileName) > 0) then begin
    SQL.SaveToFile(FileName);
  end;
end;

procedure TBDETableTool.SaveToFile;
var
  TempName: String;
begin
  TempName := Copy(FTable.TableName, 1, Pos('.',
...

read more »

Other Threads