diff --git a/packages/fcl-db/src/base/db.pas b/packages/fcl-db/src/base/db.pas index a87995ee2d..e8c372670e 100644 --- a/packages/fcl-db/src/base/db.pas +++ b/packages/fcl-db/src/base/db.pas @@ -937,7 +937,7 @@ type Function GetItem(Index: Integer): TIndexDef; Procedure SetItem(Index: Integer; Value: TIndexDef); public - constructor Create(ADataSet: TDataSet); overload; + constructor Create(ADataSet: TDataSet); virtual; overload; destructor Destroy; override; procedure Add(const Name, Fields: string; Options: TIndexOptions); Function AddIndexDef: TIndexDef; @@ -945,7 +945,7 @@ type function FindIndexForFields(const Fields: string): TIndexDef; function GetIndexForFields(const Fields: string; CaseInsensitive: Boolean): TIndexDef; - procedure Update; overload; + procedure Update; overload; virtual; Property Items[Index: Integer] : TIndexDef read GetItem write SetItem; default; end; diff --git a/packages/fcl-db/src/base/dbconst.pas b/packages/fcl-db/src/base/dbconst.pas index 39088d9d2b..9736eb6747 100644 --- a/packages/fcl-db/src/base/dbconst.pas +++ b/packages/fcl-db/src/base/dbconst.pas @@ -40,6 +40,7 @@ Resourcestring SErrIndexBasedOnUnkField = 'Index based on unknown field "%s".'; SErrConnTransactionnSet = 'Transaction of connection not set'; SErrNotASQLConnection = '"%s" is not a TSQLConnection'; + SErrNotASQLQuery = '"%s" is not a TCustomSQLQuery'; STransNotActive = 'Operation cannot be performed on an inactive transaction'; STransActive = 'Operation cannot be performed on an active transaction'; SFieldNotFound = 'Field not found : "%s"'; diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp index 8ccd129f4a..88faf44fb7 100644 --- a/packages/fcl-db/src/sqldb/sqldb.pp +++ b/packages/fcl-db/src/sqldb/sqldb.pp @@ -60,6 +60,17 @@ const 'start','commit','rollback', '?' ); +type + + { TServerIndexDefs } + + TServerIndexDefs = class(TIndexDefs) + Private + public + constructor Create(ADataSet: TDataSet); override; + procedure Update; override; + end; + { TSQLConnection } type @@ -192,12 +203,15 @@ type FServerFilterText : string; FServerFiltered : Boolean; + + FServerIndexDefs : TServerIndexDefs; FUpdateQry, FDeleteQry, FInsertQry : TCustomSQLQuery; procedure FreeFldBuffers; + function GetServerIndexDefs: TServerIndexDefs; function GetStatementType : TStatementType; procedure SetReadOnly(AValue : Boolean); procedure SetParseSQL(AValue : Boolean); @@ -214,7 +228,7 @@ type function Fetch : boolean; override; function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; override; // abstract & virtual methods of TDataset - procedure UpdateIndexDefs; override; + procedure UpdateServerIndexDefs; virtual; procedure SetDatabase(Value : TDatabase); override; Procedure SetTransaction(Value : TDBTransaction); override; procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override; @@ -287,6 +301,7 @@ type Property DataSource : TDatasource Read GetDataSource Write SetDatasource; property ServerFilter: string read FServerFilterText write SetServerFilterText; property ServerFiltered: Boolean read FServerFiltered write SetServerFiltered default False; + property ServerIndexDefs : TServerIndexDefs read GetServerIndexDefs; end; { TSQLQuery } @@ -336,6 +351,7 @@ type Property DataSource; property ServerFilter; property ServerFiltered; + property ServerIndexDefs; end; { TSQLScript } @@ -904,6 +920,11 @@ begin if assigned(FCursor) then TSQLConnection(Database).FreeFldBuffers(FCursor); end; +function TCustomSQLQuery.GetServerIndexDefs: TServerIndexDefs; +begin + Result := FServerIndexDefs; +end; + function TCustomSQLQuery.Fetch : boolean; begin if not (Fcursor.FStatementType in [stSelect]) then @@ -1150,14 +1171,13 @@ begin begin if FusePrimaryKeyAsKey then begin - UpdateIndexDefs; - for tel := 0 to indexdefs.count-1 do {with indexdefs[tel] do} + UpdateServerIndexDefs; + for tel := 0 to ServerIndexDefs.count-1 do begin - if ixPrimary in indexdefs[tel].options then + if ixPrimary in ServerIndexDefs[tel].options then begin - // Todo: If there is more then one field in the key, that must be parsed IndexFields := TStringList.Create; - ExtractStrings([';'],[' '],pchar(indexdefs[tel].fields),IndexFields); + ExtractStrings([';'],[' '],pchar(ServerIndexDefs[tel].fields),IndexFields); for fieldc := 0 to IndexFields.Count-1 do begin F := Findfield(IndexFields[fieldc]); @@ -1216,6 +1236,8 @@ begin FDeleteSQL := TStringList.Create; FDeleteSQL.OnChange := @OnChangeModifySQL; + FServerIndexDefs := TServerIndexDefs.Create(Self); + FReadOnly := false; FParseSQL := True; @@ -1239,6 +1261,7 @@ begin FreeAndNil(FInsertSQL); FreeAndNil(FDeleteSQL); FreeAndNil(FUpdateSQL); + FServerIndexDefs.Free; inherited Destroy; end; @@ -1279,12 +1302,12 @@ begin end; end; -Procedure TCustomSQLQuery.UpdateIndexDefs; +Procedure TCustomSQLQuery.UpdateServerIndexDefs; begin - Inherited; + FServerIndexDefs.Clear; if assigned(DataBase) and (FTableName<>'') then - TSQLConnection(DataBase).UpdateIndexDefs(IndexDefs,FTableName); + TSQLConnection(DataBase).UpdateIndexDefs(ServerIndexDefs,FTableName); end; Procedure TCustomSQLQuery.ApplyRecUpdate(UpdateKind : TUpdateKind); @@ -1892,6 +1915,24 @@ begin AConnection.Params.Assign(Params); end; +{ TServerIndexDefs } + +constructor TServerIndexDefs.create(ADataset: TDataset); +begin + if not (ADataset is TCustomSQLQuery) then + DatabaseError(SErrNotASQLQuery); + inherited create(ADataset); +end; + +procedure TServerIndexDefs.Update; +begin + if (not updated) and assigned(Dataset) then + begin + TCustomSQLQuery(Dataset).UpdateServerIndexDefs; + updated := True; + end; +end; + Initialization Finalization diff --git a/packages/fcl-db/tests/testfieldtypes.pas b/packages/fcl-db/tests/testfieldtypes.pas index fcf5d4ec0e..05e8c3ec25 100644 --- a/packages/fcl-db/tests/testfieldtypes.pas +++ b/packages/fcl-db/tests/testfieldtypes.pas @@ -1164,14 +1164,14 @@ var ds : TSQLQuery; begin ds := DBConnector.GetNDataset(1) as TSQLQuery; ds.Prepare; - ds.IndexDefs.Update; - AssertEquals(1,ds.IndexDefs.count); - AssertTrue(CompareText('ID',ds.indexdefs[0].Fields)=0); - Asserttrue(ds.indexdefs[0].Options=[ixPrimary,ixUnique]); - ds.IndexDefs.Update; - AssertEquals(1,ds.IndexDefs.count); - AssertTrue(CompareText('ID',ds.indexdefs[0].Fields)=0); - Asserttrue(ds.indexdefs[0].Options=[ixPrimary,ixUnique]); + ds.ServerIndexDefs.Update; + AssertEquals(1,ds.ServerIndexDefs.count); + AssertTrue(CompareText('ID',ds.ServerIndexDefs[0].Fields)=0); + Asserttrue(ds.ServerIndexDefs[0].Options=[ixPrimary,ixUnique]); + ds.ServerIndexDefs.Update; + AssertEquals(1,ds.ServerIndexDefs.count); + AssertTrue(CompareText('ID',ds.ServerIndexDefs[0].Fields)=0); + Asserttrue(ds.ServerIndexDefs[0].Options=[ixPrimary,ixUnique]); end; procedure TTestFieldTypes.TestSetBlobAsMemoParam; @@ -1227,20 +1227,20 @@ var ds : TSQLQuery; begin ds := DBConnector.GetNDataset(1) as TSQLQuery; ds.Open; - AssertEquals(1,ds.IndexDefs.count); - inddefs := HackedDataset(ds).GetIndexDefs(ds.IndexDefs,[ixPrimary]); + AssertEquals(1,ds.ServerIndexDefs.count); + inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixPrimary]); AssertEquals(1,inddefs.count); AssertTrue(CompareText('ID',inddefs[0].Fields)=0); Asserttrue(inddefs[0].Options=[ixPrimary,ixUnique]); inddefs.Free; - inddefs := HackedDataset(ds).GetIndexDefs(ds.IndexDefs,[ixPrimary,ixUnique]); + inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixPrimary,ixUnique]); AssertEquals(1,inddefs.count); AssertTrue(CompareText('ID',inddefs[0].Fields)=0); Asserttrue(inddefs[0].Options=[ixPrimary,ixUnique]); inddefs.Free; - inddefs := HackedDataset(ds).GetIndexDefs(ds.IndexDefs,[ixDescending]); + inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixDescending]); AssertEquals(0,inddefs.count); inddefs.Free; end;