mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 17:49:27 +02:00
* Correct location for IB import...
git-svn-id: trunk@11576 -
This commit is contained in:
michael
parent
07182fba98
commit
e797713e67
@ -27,9 +27,11 @@ Type
|
||||
{ TSQLDBFBDDEngine }
|
||||
|
||||
TSQLDBFBDDEngine = Class(TSQLDBDDEngine)
|
||||
private
|
||||
Protected
|
||||
Function CreateConnection(AConnectString : String) : TSQLConnection; override;
|
||||
Public
|
||||
function ImportFields(Table: TDDTableDef): Integer; override;
|
||||
Class function Description : string; override;
|
||||
Class function DBType : String; override;
|
||||
end;
|
||||
@ -43,7 +45,7 @@ Procedure UnRegisterFBDDEngine;
|
||||
|
||||
implementation
|
||||
|
||||
uses ibconnection;
|
||||
uses ibconnection, db;
|
||||
|
||||
Procedure RegisterFBDDEngine;
|
||||
|
||||
@ -75,5 +77,155 @@ begin
|
||||
Result:='Firebird/Interbase';
|
||||
end;
|
||||
|
||||
function TSQLDBFBDDEngine.ImportFields(Table: TDDTableDef): Integer;
|
||||
Const
|
||||
SQL = 'SELECT ' +
|
||||
' F.RDB$FIELD_POSITION as FieldPosition,' +
|
||||
' F.RDB$FIELD_NAME as Name,' +
|
||||
' F.RDB$NULL_FLAG as FieldNull,' +
|
||||
' F.RDB$Description as Description,' +
|
||||
' F.RDB$DEFAULT_SOURCE as FieldDefault,' +
|
||||
' D.RDB$DEFAULT_SOURCE as DomainDefault,' +
|
||||
' D.RDB$FIELD_LENGTH as CharLength,' +
|
||||
' D.RDB$FIELD_PRECISION as FieldPrecision,' +
|
||||
' D.RDB$FIELD_SCALE as Scale,' +
|
||||
' D.RDB$FIELD_TYPE as FieldType,' +
|
||||
' D.RDB$FIELD_SUB_TYPE as Subtype,' +
|
||||
' D.RDB$NULL_FLAG as DomainNull ' +
|
||||
' FROM '+
|
||||
' RDB$RELATION_FIELDS F left join RDB$FIELDS D on F.RDB$FIELD_Source = D.RDB$FIELD_NAME'+
|
||||
' WHERE (RDB$RELATION_NAME = ''%s'')' +
|
||||
' ORDER BY RDB$FIELD_POSITION';
|
||||
|
||||
Var
|
||||
Q : TSQLQuery;
|
||||
FName, FPosition, FFieldnull, FDescription, FFieldDefault, FDomainDefault,
|
||||
FCharLength, FPrecision, FScale, FFieldType, FSubType, FDomainnull : TField;
|
||||
|
||||
procedure BindFields;
|
||||
begin
|
||||
FName := q.fieldbyname('Name');
|
||||
FPosition := q.fieldbyname('FieldPosition');
|
||||
FFieldnull := q.fieldbyname('FieldNull');
|
||||
FDescription := q.fieldbyname('Description');
|
||||
FFieldDefault := q.fieldbyname('FieldDefault');
|
||||
FDomainDefault := q.fieldbyname('DomainDefault');
|
||||
FCharLength := q.fieldbyname('CharLength');
|
||||
FPrecision := q.fieldbyname('FieldPrecision');
|
||||
FScale := q.fieldbyname('Scale');
|
||||
FFieldType := q.fieldbyname('FieldType');
|
||||
FSubType := q.fieldbyname('SubType');
|
||||
FDomainnull := q.fieldbyname('Domainnull');
|
||||
end;
|
||||
|
||||
function ConvertFBFieldType (FDfieldtype, FBsubtype : integer) : TFieldType;
|
||||
var t : integer;
|
||||
b : byte;
|
||||
begin
|
||||
t := FFieldType.asinteger;
|
||||
if t > 255 then
|
||||
begin
|
||||
if t = 261 then
|
||||
result := ftBlob {BLOB}
|
||||
else
|
||||
result := ftUnknown;
|
||||
end
|
||||
else
|
||||
begin
|
||||
b := byte(t and $FF);
|
||||
if (b in [7,8,16]) and (FBsubtype <> 0) then
|
||||
// BCD types: 1= Numeric, 2 := Decimal
|
||||
result := ftBCD
|
||||
else
|
||||
case b of
|
||||
14 : result := ftFixedChar; {CHAR}
|
||||
37 : result := ftString; {VARCHAR}
|
||||
40 : result := ftString; {CSTRING ?}
|
||||
11 : result := ftFloat; {D-FLOAT ?}
|
||||
27 : result := ftFloat; {DOUBLE}
|
||||
10 : result := ftFloat; {FLOAT}
|
||||
16 : result := ftLargeint; {INT64}
|
||||
8 : result := ftInteger; {INTEGER}
|
||||
9 : result := ftlargeint; {QUAD ?}
|
||||
7 : result := ftSmallint; {SMALLINT}
|
||||
12 : result := ftDate; {DATE dialect 3}
|
||||
13 : result := ftTime; {TIME}
|
||||
35 : result := ftDateTime; {TIMESTAMP dialect 3, DATE in dialect 1,2}
|
||||
else result := ftUnknown;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{Opmerking: bestaande fielddefs die niet meer in de tabel zitten worden niet verwijderd !? }
|
||||
|
||||
function ImportFieldDef : boolean;
|
||||
var FD : TDDFieldDef;
|
||||
n, s : string;
|
||||
begin
|
||||
n := trim(FName.asstring);
|
||||
FD := Table.Fields.FindField(n);
|
||||
if not assigned (FD) then
|
||||
FD := Table.AddField(n);
|
||||
FD.FieldName := n;
|
||||
FD.FieldType := ConvertFBFieldType (FFieldType.asinteger, FSubType.asinteger);
|
||||
FD.Precision := FPrecision.asinteger;
|
||||
if FScale.asinteger < 0 then
|
||||
FD.Size := -FScale.asinteger
|
||||
else if FD.Fieldtype in [ftString, ftFixedChar] then
|
||||
FD.Size := FCharLength.asinteger
|
||||
else
|
||||
FD.Size := 0;
|
||||
{ // Fixed length types don't have a size in the dictionary
|
||||
case byte(FFieldType.asinteger and $FF) of
|
||||
7 : FD.Size := 2;
|
||||
10,8 : FD.Size := 4;
|
||||
35,11,27,9,16,12 : FD.Size := 8;
|
||||
end; }
|
||||
if not fDescription.IsNull then
|
||||
FD.Hint := FDescription.asstring;
|
||||
s := trim(FFieldDefault.asstring);
|
||||
n := trim(FDomainDefault.asstring);
|
||||
if s <> '' then
|
||||
FD.DefaultExpression:=s
|
||||
else if n <> '' then;
|
||||
FD.DefaultExpression:=n;
|
||||
if FFieldnull.asinteger = 1 then
|
||||
FD.Required:=true
|
||||
else if FDomainnull.asinteger = 1 then
|
||||
FD.Required:=true
|
||||
else
|
||||
FD.Required:=false;
|
||||
FD.index := FPosition.AsInteger;
|
||||
result := true;
|
||||
end;
|
||||
|
||||
function ImportFromSQLDef : integer;
|
||||
begin
|
||||
result := 0;
|
||||
Q.First;
|
||||
BindFields;
|
||||
while not Q.eof do
|
||||
begin
|
||||
if ImportFieldDef then
|
||||
inc (result);
|
||||
Q.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Q:=CreateSQLQuery(Nil);
|
||||
try
|
||||
Q.Sql.Text:=Format(SQL,[Table.TableName]);
|
||||
Q.Open;
|
||||
try
|
||||
result := ImportFromSQLDef;
|
||||
finally
|
||||
Q.CLose;
|
||||
end;
|
||||
finally
|
||||
Q.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -121,146 +121,18 @@ end;
|
||||
function TSQLDBDDEngine.ImportFields(Table: TDDTableDef): Integer;
|
||||
|
||||
Const
|
||||
SQL = 'SELECT ' +
|
||||
' F.RDB$FIELD_POSITION as FieldPosition,' +
|
||||
' F.RDB$FIELD_NAME as Name,' +
|
||||
' F.RDB$NULL_FLAG as FieldNull,' +
|
||||
' F.RDB$Description as Description,' +
|
||||
' F.RDB$DEFAULT_SOURCE as FieldDefault,' +
|
||||
' D.RDB$DEFAULT_SOURCE as DomainDefault,' +
|
||||
' D.RDB$FIELD_LENGTH as CharLength,' +
|
||||
' D.RDB$FIELD_PRECISION as FieldPrecision,' +
|
||||
' D.RDB$FIELD_SCALE as Scale,' +
|
||||
' D.RDB$FIELD_TYPE as FieldType,' +
|
||||
' D.RDB$FIELD_SUB_TYPE as Subtype,' +
|
||||
' D.RDB$NULL_FLAG as DomainNull ' +
|
||||
' FROM '+
|
||||
' RDB$RELATION_FIELDS F left join RDB$FIELDS D on F.RDB$FIELD_Source = D.RDB$FIELD_NAME'+
|
||||
' WHERE (RDB$RELATION_NAME = ''%s'')' +
|
||||
' ORDER BY RDB$FIELD_POSITION';
|
||||
SQL = 'SELECT * from %s where (1=0)';
|
||||
|
||||
Var
|
||||
Q : TSQLQuery;
|
||||
FName, FPosition, FFieldnull, FDescription, FFieldDefault, FDomainDefault,
|
||||
FCharLength, FPrecision, FScale, FFieldType, FSubType, FDomainnull : TField;
|
||||
|
||||
procedure BindFields;
|
||||
begin
|
||||
FName := q.fieldbyname('Name');
|
||||
FPosition := q.fieldbyname('FieldPosition');
|
||||
FFieldnull := q.fieldbyname('FieldNull');
|
||||
FDescription := q.fieldbyname('Description');
|
||||
FFieldDefault := q.fieldbyname('FieldDefault');
|
||||
FDomainDefault := q.fieldbyname('DomainDefault');
|
||||
FCharLength := q.fieldbyname('CharLength');
|
||||
FPrecision := q.fieldbyname('FieldPrecision');
|
||||
FScale := q.fieldbyname('Scale');
|
||||
FFieldType := q.fieldbyname('FieldType');
|
||||
FSubType := q.fieldbyname('SubType');
|
||||
FDomainnull := q.fieldbyname('Domainnull');
|
||||
end;
|
||||
|
||||
function ConvertFBFieldType (FDfieldtype, FBsubtype : integer) : TFieldType;
|
||||
var t : integer;
|
||||
b : byte;
|
||||
begin
|
||||
t := FFieldType.asinteger;
|
||||
if t > 255 then
|
||||
begin
|
||||
if t = 261 then
|
||||
result := ftBlob {BLOB}
|
||||
else
|
||||
result := ftUnknown;
|
||||
end
|
||||
else
|
||||
begin
|
||||
b := byte(t and $FF);
|
||||
if (b in [7,8,16]) and (FBsubtype <> 0) then
|
||||
// BCD types: 1= Numeric, 2 := Decimal
|
||||
result := ftBCD
|
||||
else
|
||||
case b of
|
||||
14 : result := ftFixedChar; {CHAR}
|
||||
37 : result := ftString; {VARCHAR}
|
||||
40 : result := ftString; {CSTRING ?}
|
||||
11 : result := ftFloat; {D-FLOAT ?}
|
||||
27 : result := ftFloat; {DOUBLE}
|
||||
10 : result := ftFloat; {FLOAT}
|
||||
16 : result := ftLargeint; {INT64}
|
||||
8 : result := ftInteger; {INTEGER}
|
||||
9 : result := ftlargeint; {QUAD ?}
|
||||
7 : result := ftSmallint; {SMALLINT}
|
||||
12 : result := ftDate; {DATE dialect 3}
|
||||
13 : result := ftTime; {TIME}
|
||||
35 : result := ftDateTime; {TIMESTAMP dialect 3, DATE in dialect 1,2}
|
||||
else result := ftUnknown;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{Opmerking: bestaande fielddefs die niet meer in de tabel zitten worden niet verwijderd !? }
|
||||
|
||||
function ImportFieldDef : boolean;
|
||||
var FD : TDDFieldDef;
|
||||
n, s : string;
|
||||
begin
|
||||
n := trim(FName.asstring);
|
||||
FD := Table.Fields.FindField(n);
|
||||
if not assigned (FD) then
|
||||
FD := Table.AddField(n);
|
||||
FD.FieldName := n;
|
||||
FD.FieldType := ConvertFBFieldType (FFieldType.asinteger, FSubType.asinteger);
|
||||
FD.Precision := FPrecision.asinteger;
|
||||
if FScale.asinteger < 0 then
|
||||
FD.Size := -FScale.asinteger
|
||||
else if FD.Fieldtype in [ftString, ftFixedChar] then
|
||||
FD.Size := FCharLength.asinteger
|
||||
else
|
||||
FD.Size := 0;
|
||||
{ // Fixed length types don't have a size in the dictionary
|
||||
case byte(FFieldType.asinteger and $FF) of
|
||||
7 : FD.Size := 2;
|
||||
10,8 : FD.Size := 4;
|
||||
35,11,27,9,16,12 : FD.Size := 8;
|
||||
end; }
|
||||
if not fDescription.IsNull then
|
||||
FD.Hint := FDescription.asstring;
|
||||
s := trim(FFieldDefault.asstring);
|
||||
n := trim(FDomainDefault.asstring);
|
||||
if s <> '' then
|
||||
FD.DefaultExpression:=s
|
||||
else if n <> '' then;
|
||||
FD.DefaultExpression:=n;
|
||||
if FFieldnull.asinteger = 1 then
|
||||
FD.Required:=true
|
||||
else if FDomainnull.asinteger = 1 then
|
||||
FD.Required:=true
|
||||
else
|
||||
FD.Required:=false;
|
||||
FD.index := FPosition.AsInteger;
|
||||
result := true;
|
||||
end;
|
||||
|
||||
function ImportFromSQLDef : integer;
|
||||
begin
|
||||
result := 0;
|
||||
Q.First;
|
||||
BindFields;
|
||||
while not Q.eof do
|
||||
begin
|
||||
if ImportFieldDef then
|
||||
inc (result);
|
||||
Q.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Q:=CreateSQLQuery(Nil);
|
||||
try
|
||||
Q.Sql.Text:=Format(SQL,[Table.TableName]);
|
||||
Q.Open;
|
||||
try
|
||||
result := ImportFromSQLDef;
|
||||
Result:=Table.ImportFromDataset(Q);
|
||||
finally
|
||||
Q.CLose;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user