* Added TSQLQuery.ServerIndexDefs, the indexes on the server are now stored in this new property instead of IndexDefs which from now on only stores the local indexes

git-svn-id: trunk@9975 -

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;
 

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"';

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
@@ -193,11 +204,14 @@ 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

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;