Merged revisions 10615,10617,10622-10624,10627,10639-10641,10645-10646,10649-10650,10653-10654,10656-10658,10660-10662,10664-10667,10670-10671,10673-10676 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
  r10615 | joost | 2008-04-08 19:04:12 +0200 (Tue, 08 Apr 2008) | 1 line
  
   * Patch from Petr Kristan to fix TDataSet.SetFieldDefs
........
  r10627 | joost | 2008-04-11 22:26:03 +0200 (Fri, 11 Apr 2008) | 1 line
  
   * Moved code to clear calculated fields from TDataset to TBufDataset, based on patch from Petr Kristan
........
  r10650 | joost | 2008-04-13 18:05:20 +0200 (Sun, 13 Apr 2008) | 1 line
  
   * Fix testLargeIntValues
........
  r10653 | joost | 2008-04-13 18:43:36 +0200 (Sun, 13 Apr 2008) | 1 line
  
   * Placed warning in the code that RowsAffected does not work properly with range-checking
........
  r10654 | joost | 2008-04-13 18:51:11 +0200 (Sun, 13 Apr 2008) | 2 lines
  
   * Implemented descending indexes, for those too lazy to use last-prior-prior ;)
   * TBufDataset.AddIndex has got the new parameters options,descfields and caseinsfields
........
  r10656 | joost | 2008-04-13 19:47:04 +0200 (Sun, 13 Apr 2008) | 1 line
  
   * Removed obsolete code
........
  r10657 | joost | 2008-04-13 20:35:03 +0200 (Sun, 13 Apr 2008) | 1 line
  
   * Case-insensitive indexes support
........
  r10670 | joost | 2008-04-15 23:12:52 +0200 (Tue, 15 Apr 2008) | 1 line
  
   * Do not search for a semicolon anymore to check if there is more then one field in FieldValues
........
  r10671 | joost | 2008-04-15 23:29:56 +0200 (Tue, 15 Apr 2008) | 3 lines
  
   * Fixed test TestAddDblIndex
   * Set the function result properly in DBCompareText 
   * Rewrote TBufDataset.Locate, it now uses parts of the indexes-code (+test)
........
  r10676 | joost | 2008-04-16 10:32:03 +0200 (Wed, 16 Apr 2008) | 5 lines
  
   Patch from Luiz Americo:
  - Correctly recognizes fields resulted from an expression or subquery
  - Remove unnecessary fields (FExpected*)
  - Group boolean fields together
  - Format surrounding code
........

git-svn-id: branches/fixes_2_2@10695 -

packages/fcl-db/src/base/bufdataset.pas

@@ -110,6 +110,8 @@ type
   TDBCompareRec = record
                    Comparefunc : TCompareFunc;
                    Off1,Off2   : PtrInt;
+                   Options     : TLocateOptions;
+                   Desc        : Boolean;
                   end;
   TDBCompareStruct = array of TDBCompareRec;
 
@@ -120,6 +122,7 @@ type
     FieldsName      : String;
     CaseinsFields   : String;
     DescFields      : String;
+    Options         : TIndexOptions;
     DBCompareStruct : TDBCompareStruct;
 {$IFDEF ARRAYBUF}
     FCurrentRecInd  : integer;
@@ -175,8 +178,6 @@ type
     function GetIndexDefs : TIndexDefs;
 {$IFDEF ARRAYBUF}
     procedure AddRecordToIndex(var AIndex: TBufIndex; ARecBuf: pchar);
-{$ELSE}
-    procedure AddRecordToIndex(var AIndex: TBufIndex; ARecBuf: PBufRecLinkItem);
 {$ENDIF}
     function  GetCurrentBuffer: PChar;
     procedure CalcRecordSize;
@@ -186,6 +187,7 @@ type
     function LoadBuffer(Buffer : PChar): TGetResult;
     function GetFieldSize(FieldDef : TFieldDef) : longint;
     function GetRecordUpdateBuffer : boolean;
+    procedure ProcessFieldCompareStruct(AField: TField; var ACompareRec : TDBCompareRec);
     procedure SetIndexFieldNames(const AValue: String);
     procedure SetIndexName(AValue: String);
 {$IFNDEF ARRAYBUF}
@@ -209,6 +211,7 @@ type
     function GetChangeCount: integer; virtual;
     function  AllocRecordBuffer: PChar; override;
     procedure FreeRecordBuffer(var Buffer: PChar); override;
+    procedure ClearCalcFields(Buffer: PChar); override;
     procedure InternalInitRecord(Buffer: PChar); override;
     function  GetCanModify: Boolean; override;
     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
@@ -216,7 +219,8 @@ type
     procedure InternalClose; override;
     function getnextpacket : integer;
     function GetRecordSize: Word; override;
-    procedure InternalAddIndex(const AName, AFields : string); virtual;
+    procedure InternalAddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string;
+      const ACaseInsFields: string); virtual;
     procedure InternalPost; override;
     procedure InternalCancel; Override;
     procedure InternalDelete; override;
@@ -254,7 +258,8 @@ type
     function Locate(const keyfields: string; const keyvalues: Variant; options: TLocateOptions) : boolean; override;
     function UpdateStatus: TUpdateStatus; override;
     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
-    procedure AddIndex(const AName, AFields : string); virtual;
+    procedure AddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string = '';
+      const ACaseInsFields: string = ''); virtual;
     property ChangeCount : Integer read GetChangeCount;
 {$IFNDEF ARRAYBUF}
     property MaxIndexesCount : Integer read FMaxIndexesCount write SetMaxIndexesCount;
@@ -299,7 +304,7 @@ end;
 function DBCompareText(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
 
 begin
-  DBCompareTextLen(subValue,aValue,Length(pchar(subValue)),options);
+  Result := DBCompareTextLen(subValue,aValue,Length(pchar(subValue)),options);
 end;
 
 function DBCompareByte(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
@@ -352,8 +357,13 @@ var IndexFieldNr : Integer;
 begin
   for IndexFieldNr:=0 to length(ADBCompareRecs)-1 do with ADBCompareRecs[IndexFieldNr] do
     begin
-    Result := Comparefunc(Rec1+Off1,Rec2+Off2,[]);
-    if Result <> 0 then break;
+    Result := Comparefunc(Rec1+Off1,Rec2+Off2,Options);
+    if Result <> 0 then
+      begin
+      if Desc then
+        Result := -Result;
+      break;
+      end;
     end;
 end;
 
@@ -371,8 +381,8 @@ begin
   FMaxIndexesCount:=2;
 {$ENDIF}
   FIndexesCount:=0;
-  InternalAddIndex('DEFAULT_ORDER','');
-  InternalAddIndex('','');
+  InternalAddIndex('DEFAULT_ORDER','',[],'','');
+  InternalAddIndex('','',[],'','');
   FCurrentIndex:=@FIndexes[0];
 
   FIndexDefs := TIndexDefs.Create(Self);
@@ -411,7 +421,9 @@ var PCurRecLinkItem : PBufRecLinkItem;
     MergeAmount     : integer;
     PlaceQRec       : boolean;
 
-    IndexFields     : TStrings;
+    IndexFields     : TList;
+    DescIndexFields : TList;
+    CInsIndexFields : TList;
     FieldsAmount    : Integer;
     FieldNr         : integer;
     AField          : TField;
@@ -438,36 +450,32 @@ begin
   // Build the DBCompareStructure
   with AIndex do
     begin
-    IndexFields := TStringList.Create;
+    IndexFields := TList.Create;
+    DescIndexFields := TList.Create;
+    CInsIndexFields := TList.Create;
     try
-      FieldsAmount:=ExtractStrings([','],[' '],pchar(FieldsName),IndexFields);
+      GetFieldList(IndexFields,FieldsName);
+      FieldsAmount:=IndexFields.Count;
+      GetFieldList(DescIndexFields,DescFields);
+      GetFieldList(CInsIndexFields,CaseinsFields);
       if FieldsAmount=0 then
         DatabaseError(SNoIndexFieldNameGiven);
       SetLength(DBCompareStruct,FieldsAmount);
       for FieldNr:=0 to FieldsAmount-1 do
         begin
-        AField := FindField(IndexFields[FieldNr]);
-        if not assigned(AField) then
-          DatabaseErrorFmt(SErrIndexBasedOnUnkField,[IndexFields[FieldNr]]);
-
-        case AField.DataType of
-          ftString : DBCompareStruct[FieldNr].Comparefunc := @DBCompareText;
-          ftSmallint : DBCompareStruct[FieldNr].Comparefunc := @DBCompareSmallInt;
-          ftInteger,ftCurrency,ftBCD : DBCompareStruct[FieldNr].Comparefunc := @DBCompareInt;
-          ftWord : DBCompareStruct[FieldNr].Comparefunc := @DBCompareWord;
-          ftBoolean : DBCompareStruct[FieldNr].Comparefunc := @DBCompareByte;
-          ftFloat : DBCompareStruct[FieldNr].Comparefunc := @DBCompareDouble;
-          ftDateTime,ftDate,ftTime : DBCompareStruct[FieldNr].Comparefunc := @DBCompareDouble;
-          ftLargeint : DBCompareStruct[FieldNr].Comparefunc := @DBCompareLargeInt;
+        AField := TField(IndexFields[FieldNr]);
+        ProcessFieldCompareStruct(AField,DBCompareStruct[FieldNr]);
+
+        DBCompareStruct[FieldNr].Desc := (DescIndexFields.IndexOf(AField)>-1);
+        if (CInsIndexFields.IndexOf(AField)>-1) then
+          DBCompareStruct[FieldNr].Options := [loCaseInsensitive]
         else
-          DatabaseErrorFmt(SErrIndexBasedOnInvField,[AField.FieldName]);
-        end;
+          DBCompareStruct[FieldNr].Options := [];
 
-        DBCompareStruct[FieldNr].Off1:=sizeof(TBufRecLinkItem)*FMaxIndexesCount+FFieldBufPositions[AField.FieldNo-1];
-        DBCompareStruct[FieldNr].Off2:=DBCompareStruct[FieldNr].Off1;
-        
         end;
     finally
+      CInsIndexFields.Free;
+      DescIndexFields.Free;
       IndexFields.Free;
     end;
     end;
@@ -608,6 +616,7 @@ begin
     Fields := FIndexes[i].FieldsName;
     DescFields:= FIndexes[i].DescFields;
     CaseInsFields:=FIndexes[i].CaseinsFields;
+    Options:=FIndexes[i].Options;
     end;
 end;
 
@@ -639,6 +648,12 @@ begin
   ReAllocMem(Buffer,0);
 end;
 
+procedure TBufDataset.ClearCalcFields(Buffer: PChar);
+begin
+  if CalcFieldsSize > 0 then
+    FillByte((Buffer+RecordSize)^,CalcFieldsSize,0);
+end;
+
 procedure TBufDataset.InternalOpen;
 
 var IndexNr : integer;
@@ -943,6 +958,28 @@ begin
   Result := (FCurrentUpdateBuffer < length(FUpdateBuffer))  and CompareBuf(FCurrentUpdateBuffer);
 end;
 
+procedure TBufDataset.ProcessFieldCompareStruct(AField: TField; var ACompareRec : TDBCompareRec);
+begin
+  case AField.DataType of
+    ftString : ACompareRec.Comparefunc := @DBCompareText;
+    ftSmallint : ACompareRec.Comparefunc := @DBCompareSmallInt;
+    ftInteger, ftCurrency, ftBCD : ACompareRec.Comparefunc :=
+      @DBCompareInt;
+    ftWord : ACompareRec.Comparefunc := @DBCompareWord;
+    ftBoolean : ACompareRec.Comparefunc := @DBCompareByte;
+    ftFloat : ACompareRec.Comparefunc := @DBCompareDouble;
+    ftDateTime, ftDate, ftTime : ACompareRec.Comparefunc :=
+      @DBCompareDouble;
+    ftLargeint : ACompareRec.Comparefunc := @DBCompareLargeInt;
+  else
+    DatabaseErrorFmt(SErrIndexBasedOnInvField, [AField.FieldName]);
+  end;
+
+  ACompareRec.Off1:=sizeof(TBufRecLinkItem)*FMaxIndexesCount+
+    FFieldBufPositions[AField.FieldNo-1];
+  ACompareRec.Off2:=ACompareRec.Off1;
+end;
+
 procedure TBufDataset.SetIndexFieldNames(const AValue: String);
 begin
   if AValue<>'' then
@@ -1033,19 +1070,11 @@ end;
 
 {$IFDEF ARRAYBUF}
 procedure TBufDataset.AddRecordToIndex(var AIndex: TBufIndex; ARecBuf : pchar);
-{$ELSE}
-procedure TBufDataset.AddRecordToIndex(var AIndex: TBufIndex; ARecBuf : PBufRecLinkItem);
-{$ENDIF}
 var cp : integer;
     NewValueBufLen : Integer;
-{$IFDEF ARRAYBUF}
     NewValueBuf,CompValueBuf : pchar;
     RecInd : integer;
     HighVal,LowVal : Integer;
-{$ELSE}
-    NewValueBuf : pchar;
-    CompBuf : PBufRecLinkItem;
-{$ENDIF}
 begin
   if not assigned(AIndex.Fields) then
     AIndex.Fields := FieldByName(AIndex.FieldsName);
@@ -1053,7 +1082,6 @@ begin
   NewValueBuf:=pchar(ARecBuf);
   inc(NewValueBuf,FFieldBufPositions[AIndex.Fields.FieldNo-1]);
 
-{$IFDEF ARRAYBUF}
   NewValueBufLen:= Length(NewValueBuf);
   HighVal := AIndex.FLastRecInd;
   LowVal := 0;
@@ -1090,32 +1118,8 @@ begin
   move(AIndex.FRecordArray[RecInd],AIndex.FRecordArray[RecInd+1],sizeof(pointer)*(AIndex.FLastRecInd-RecInd+5)); // Let op. Moet zijn +1?
   AIndex.FRecordArray[RecInd]:= ARecBuf;
   inc(AIndex.FLastRecInd)
-{$ELSE}
-  inc(NewValueBuf,sizeof(TBufRecLinkItem)*FMaxIndexesCount);
-  NewValueBufLen:= Length(pchar(NewValueBuf));
-  CompBuf:=AIndex.FFirstRecBuf;
-
-  cp := 1;
-  while (cp>0) and (CompBuf<>AIndex.FLastRecBuf) do
-    begin
-    if AIndex.Fields.DataType = ftString then
-      begin
-      cp := DBCompareTextLen(pointer(NewValueBuf),pchar(CompBuf)+sizeof(TBufRecLinkItem)*FMaxIndexesCount+FFieldBufPositions[AIndex.Fields.FieldNo-1],NewValueBufLen,[]);
-      if cp > 0 then
-        CompBuf := CompBuf[AIndex.IndNr].next;
-      end;
-    end;
-
-  ARecBuf[AIndex.IndNr].next:= CompBuf;
-  ARecBuf[AIndex.IndNr].prior:= CompBuf[AIndex.IndNr].prior;
-
-  if assigned(CompBuf[AIndex.IndNr].prior) then
-    CompBuf[AIndex.IndNr].prior[AIndex.IndNr].next := ARecBuf
-  else
-    AIndex.FFirstRecBuf:=ARecBuf;
-  CompBuf[AIndex.IndNr].prior := ARecBuf;
-{$ENDIF}
 end;
+{$ENDIF}
 
 function TBufDataset.getnextpacket : integer;
 
@@ -2069,7 +2073,8 @@ begin
     end;
 end;
 
-procedure TBufDataset.AddIndex(const AName, AFields: string);
+procedure TBufDataset.AddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string = '';
+                               const ACaseInsFields: string = '');
 begin
   if AFields='' then DatabaseError(SNoIndexFieldNameGiven);
   
@@ -2081,10 +2086,11 @@ begin
   // If not all packets are fetched, you can not sort properly.
   if not active then
     FPacketRecords:=-1;
-  InternalAddIndex(AName,AFields);
+  InternalAddIndex(AName,AFields,AOptions,ADescFields,ACaseInsFields);
 end;
 
-procedure TBufDataset.InternalAddIndex(const AName, AFields: string);
+procedure TBufDataset.InternalAddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string;
+                                       const ACaseInsFields: string);
 var StoreIndNr : Integer;
 begin
   if Active then FetchAll;
@@ -2100,6 +2106,9 @@ begin
     begin
     Name:=AName;
     FieldsName:=AFields;
+    DescFields:=ADescFields;
+    CaseinsFields:=ACaseInsFields;
+    Options:=AOptions;
     IndNr:=FIndexesCount-1;
     end;
 
@@ -2253,96 +2262,62 @@ end;
 
 Function TBufDataset.Locate(const KeyFields: string; const KeyValues: Variant; options: TLocateOptions) : boolean;
 
-var keyfield    : TField;     // Field to search in
-    ValueBuffer : pchar;      // Pointer to value to search for, in TField' internal format
-    VBLength    : integer;
-
-    FieldBufPos : PtrInt;     // Amount to add to the record buffer to get the FieldBuffer
-    CurrLinkItem: PBufRecLinkItem;
-    CurrBuff    : pchar;
-    bm          : TBufBookmark;
+var CurrLinkItem    : PBufRecLinkItem;
+    bm              : TBufBookmark;
+    SearchFields    : TList;
+    FieldsAmount    : Integer;
+    DBCompareStruct : TDBCompareStruct;
+    FieldNr         : Integer;
+    StoreDSState    : TDataSetState;
+    FilterBuffer    : PChar;
 
-    CheckNull   : Boolean;
-    SaveState   : TDataSetState;
 
 begin
 {$IFDEF ARRAYBUF}
   DatabaseError('Locate is not supported');
 {$ELSE}
-// For now it is only possible to search in one field at the same time
-  result := False;
-
+  Result := False;
   if IsEmpty then exit;
 
-  keyfield := FieldByName(keyfields);
-  CheckNull := VarIsNull(KeyValues);
+  // Build the DBCompare structure
+  SearchFields := TList.Create;
+  try
+    GetFieldList(SearchFields,KeyFields);
+    FieldsAmount:=SearchFields.Count;
+    if FieldsAmount=0 then exit;
 
-  if not CheckNull then
-    begin
-    SaveState := State;
-    SetTempState(dsFilter);
-    keyfield.Value := KeyValues;
-    RestoreState(SaveState);
-
-    FieldBufPos := FFieldBufPositions[keyfield.FieldNo-1];
-    VBLength := keyfield.DataSize;
-    ValueBuffer := AllocMem(VBLength);
-    currbuff := pointer(FCurrentIndex^.FLastRecBuf)+sizeof(TBufRecLinkItem)*FMaxIndexesCount+FieldBufPos;
-    move(currbuff^,ValueBuffer^,VBLength);
-    end;
+    SetLength(DBCompareStruct,FieldsAmount);
+    for FieldNr:=0 to FieldsAmount-1 do
+      ProcessFieldCompareStruct(TField(SearchFields[FieldNr]),DBCompareStruct[FieldNr]);
+  finally
+    SearchFields.Free;
+  end;
 
+  // Set The filter-buffer
+  StoreDSState:=State;
+  SetTempState(dsFilter);
+  SetFieldValues(keyfields,KeyValues);
   CurrLinkItem := FCurrentIndex^.FFirstRecBuf;
+  FilterBuffer:=IntAllocRecordBuffer;
+  move(FCurrentIndex^.FLastRecBuf^,FilterBuffer^,FRecordsize+sizeof(TBufRecLinkItem)*FMaxIndexesCount);
+  SetTempState(StoreDSState);
 
-  if CheckNull then
+  // Iterate through the records until a match is found
+  while (CurrLinkItem <> FCurrentIndex^.FLastRecBuf) do
     begin
-    repeat
-    currbuff := pointer(CurrLinkItem)+sizeof(TBufRecLinkItem)*FMaxIndexesCount;
-    if GetFieldIsnull(pbyte(CurrBuff),keyfield.Fieldno-1) then
+    if (IndexCompareRecords(FilterBuffer,CurrLinkItem,DBCompareStruct) = 0) then
       begin
-      result := True;
+      Result := True;
       break;
       end;
     CurrLinkItem := CurrLinkItem^.next;
-    if CurrLinkItem = FCurrentIndex^.FLastRecBuf then getnextpacket;
-    until CurrLinkItem = FCurrentIndex^.FLastRecBuf;
-    end
-  else if keyfield.DataType = ftString then
-    begin
-    repeat
-    currbuff := pointer(CurrLinkItem)+sizeof(TBufRecLinkItem)*FMaxIndexesCount;
-    if not GetFieldIsnull(pbyte(CurrBuff),keyfield.Fieldno-1) then
-      begin
-      inc(CurrBuff,FieldBufPos);
-      if DBCompareTextLen(ValueBuffer,CurrBuff,VBLength,options) = 0 then
-        begin
-        result := True;
-        break;
-        end;
-      end;
-    CurrLinkItem := CurrLinkItem^.next;
-    if CurrLinkItem = FCurrentIndex^.FLastRecBuf then getnextpacket;
-    until CurrLinkItem = FCurrentIndex^.FLastRecBuf;
-    end
-  else
-    begin
-    repeat
-    currbuff := pointer(CurrLinkItem)+sizeof(TBufRecLinkItem)*FMaxIndexesCount;
-    if not GetFieldIsnull(pbyte(CurrBuff),keyfield.Fieldno-1) then
-      begin
-      inc(CurrBuff,FieldBufPos);
-      if CompareByte(ValueBuffer^,CurrBuff^,VBLength) = 0 then
-        begin
-        result := True;
-        break;
-        end;
-      end;
-
-    CurrLinkItem := CurrLinkItem^.next;
-    if CurrLinkItem = FCurrentIndex^.FLastRecBuf then getnextpacket;
-    until CurrLinkItem = FCurrentIndex^.FLastRecBuf;
+    if CurrLinkItem = FCurrentIndex^.FLastRecBuf then
+      getnextpacket;
     end;
+    
+  FreeRecordBuffer(FilterBuffer);
 
-
+  // If a match is found, jump to the found record
   if Result then
     begin
 {$IFDEF ARRAYBUF}
@@ -2353,8 +2328,6 @@ begin
     bm.BookmarkFlag := bfCurrent;
     GotoBookmark(@bm);
     end;
-
-  ReAllocmem(ValueBuffer,0);
 {$ENDIF}
 end;
 

packages/fcl-db/src/base/db.pas

@@ -1130,6 +1130,7 @@ type
     Function GetActive : boolean;
     Procedure UnRegisterDataSource(ADatasource : TDatasource);
     Procedure UpdateFieldDefs;
+    Procedure SetFieldDefs(AFieldDefs: TFieldDefs);
   protected
     procedure RecalcBufListSize;
     procedure ActivateBuffers; virtual;
@@ -1312,7 +1313,7 @@ type
     property DefaultFields: Boolean read FDefaultFields;
     property EOF: Boolean read FEOF;
     property FieldCount: Longint read GetFieldCount;
-    property FieldDefs: TFieldDefs read FFieldDefs write FFieldDefs;
+    property FieldDefs: TFieldDefs read FFieldDefs write SetFieldDefs;
 //    property Fields[Index: Longint]: TField read GetField write SetField;
     property Found: Boolean read FFound;
     property Modified: Boolean read FModified write SetModified;

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -865,6 +865,10 @@ end;
 function TConnectionName.RowsAffected(cursor: TSQLCursor): TRowsCount;
 begin
   if assigned(cursor) then
+    // Compile this without range-checking. RowsAffected can be -1, although
+    // it's an unsigned integer. (small joke from the mysql-guys)
+    // Without range-checking this goes ok. If Range is turned on, this results
+    // in range-check errors.
     Result := (cursor as TCursorName).RowsAffected
   else
     Result := -1;

packages/fcl-db/src/sqlite/customsqliteds.pas

@@ -91,13 +91,7 @@ type
     {$endif}
     FInternalActiveBuffer: PDataRecord;
     FInsertBookmark: PDataRecord;
-    FExpectedAppends: Integer;
-    FExpectedDeletes: Integer;
-    FExpectedUpdates: Integer;
     FOnCallback: TSqliteCallback;
-    FSaveOnClose: Boolean;
-    FSaveOnRefetch: Boolean;
-    FAutoIncrementKey: Boolean;
     FMasterLink: TMasterDataLink;
     FIndexFieldNames: String;
     FIndexFieldList: TList;
@@ -121,7 +115,6 @@ type
     FDeletedItems: TFPList;
     FReturnCode: Integer;
     FSqliteHandle: Pointer;
-    FDataAllocated: Boolean;
     FRowBufferSize: Integer;
     FRowCount: Integer;
     FRecordCount: Integer;
@@ -129,6 +122,10 @@ type
     FEndItem: PDataRecord;
     FCacheItem: PDataRecord;
     FGetSqlStr: array of TGetSqlStrFunction;
+    FSaveOnClose: Boolean;
+    FSaveOnRefetch: Boolean;
+    FAutoIncrementKey: Boolean;
+    FDataAllocated: Boolean;
     function SqliteExec(Sql:PChar; ACallback: TSqliteCdeclCallback; Data: Pointer):Integer;virtual; abstract;
     procedure InternalCloseHandle;virtual;abstract;
     function InternalGetHandle: Pointer; virtual; abstract;
@@ -212,9 +209,9 @@ type
     procedure SetCurrentItem(Value:PDataRecord);
     property FCurrentItem: PDataRecord read FFCurrentItem write SetCurrentItem;
     {$endif}
-    property ExpectedAppends: Integer read FExpectedAppends write SetExpectedAppends;
-    property ExpectedUpdates: Integer read FExpectedUpdates write SetExpectedUpdates;
-    property ExpectedDeletes: Integer read FExpectedDeletes write SetExpectedDeletes;
+    property ExpectedAppends: Integer write SetExpectedAppends;
+    property ExpectedUpdates: Integer write SetExpectedUpdates;
+    property ExpectedDeletes: Integer write SetExpectedDeletes;
     property IndexFields[Value: Integer]: TField read GetIndexFields;
     property RowsAffected: Integer read GetRowsAffected;
     property ReturnCode: Integer read FReturnCode;

packages/fcl-db/src/sqlite/sqlite3ds.pas

@@ -152,50 +152,52 @@ begin
 end;
 
 procedure TSqlite3Dataset.InternalInitFieldDefs;
+const
+  FieldSizeMap: array[Boolean] of Integer = (0, dsMaxStringSize);
 var
-  vm:Pointer;
-  ColumnStr:String;
-  i,ColumnCount:Integer;
-  AType:TFieldType;
+  vm: Pointer;
+  ColumnStr: String;
+  i, ColumnCount: Integer;
+  AType: TFieldType;
 begin
   {$ifdef DEBUG}
   WriteLn('##TSqlite3Dataset.InternalInitFieldDefs##');
   {$endif}
-  FAutoIncFieldNo:=-1;
+  FAutoIncFieldNo := -1;
   FieldDefs.Clear;
   FReturnCode := sqlite3_prepare(FSqliteHandle, PChar(FSql), -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString, Self);
   sqlite3_step(vm);
-  ColumnCount:=sqlite3_column_count(vm);
+  ColumnCount := sqlite3_column_count(vm);
   //Set BufferSize
-  FRowBufferSize:=(SizeOf(PPChar)*ColumnCount);
+  FRowBufferSize := (SizeOf(PPChar) * ColumnCount);
   //Prepare the array of pchar2sql functions
-  SetLength(FGetSqlStr,ColumnCount);
+  SetLength(FGetSqlStr, ColumnCount);
   for i := 0 to ColumnCount - 1 do
   begin
-   ColumnStr := UpperCase(String(sqlite3_column_decltype(vm,i)));
+   ColumnStr := UpperCase(String(sqlite3_column_decltype(vm, i)));
    if (ColumnStr = 'INTEGER') or (ColumnStr = 'INT') then
    begin
-     if AutoIncrementKey and (UpperCase(String(sqlite3_column_name(vm,i))) = UpperCase(PrimaryKey)) then
+     if AutoIncrementKey and (UpperCase(String(sqlite3_column_name(vm, i))) = UpperCase(PrimaryKey)) then
      begin
        AType := ftAutoInc;
        FAutoIncFieldNo := i;
      end
      else
        AType := ftInteger;     
-   end else if Pos('VARCHAR',ColumnStr) = 1 then
+   end else if Pos('VARCHAR', ColumnStr) = 1 then
    begin
      AType := ftString;
-   end else if Pos('BOOL',ColumnStr) = 1 then
+   end else if Pos('BOOL', ColumnStr) = 1 then
    begin
      AType := ftBoolean;
-   end else if Pos('AUTOINC',ColumnStr) = 1 then
+   end else if Pos('AUTOINC', ColumnStr) = 1 then
    begin
      AType := ftAutoInc;
      if FAutoIncFieldNo = -1 then
        FAutoIncFieldNo := i;
-   end else if (Pos('FLOAT',ColumnStr)=1) or (Pos('NUMERIC',ColumnStr)=1) then
+   end else if (Pos('FLOAT', ColumnStr) = 1) or (Pos('NUMERIC', ColumnStr) = 1) then
    begin
      AType := ftFloat;
    end else if (ColumnStr = 'DATETIME') then
@@ -219,27 +221,34 @@ begin
    end else if (ColumnStr = 'WORD') then
    begin
      AType := ftWord;
+   end else if (ColumnStr = '') then
+   begin
+     case sqlite3_column_type(vm, i) of
+       SQLITE_INTEGER:
+         AType := ftInteger;
+       SQLITE_FLOAT:
+         AType := ftFloat;
+     else
+       AType := ftString;
+     end;
    end else
    begin
      AType := ftString;
    end;
-   if AType = ftString then
-     FieldDefs.Add(String(sqlite3_column_name(vm,i)), AType, dsMaxStringSize)
-   else
-     FieldDefs.Add(String(sqlite3_column_name(vm,i)), AType);  
+   FieldDefs.Add(String(sqlite3_column_name(vm, i)), AType, FieldSizeMap[AType = ftString]);
    //Set the pchar2sql function
-   if AType in [ftString,ftMemo] then
-     FGetSqlStr[i]:=@Char2SqlStr
+   if AType in [ftString, ftMemo] then
+     FGetSqlStr[i] := @Char2SqlStr
    else
-     FGetSqlStr[i]:=@Num2SqlStr;
+     FGetSqlStr[i] := @Num2SqlStr;
    {$ifdef DEBUG}
-   writeln('  Field[',i,'] Name: ',sqlite3_column_name(vm,i));
-   writeln('  Field[',i,'] Type: ',sqlite3_column_decltype(vm,i));
+   writeln('  Field[',i,'] Name: ', sqlite3_column_name(vm,i));
+   writeln('  Field[',i,'] Type: ', sqlite3_column_decltype(vm,i));
    {$endif}
   end;
   sqlite3_finalize(vm);
   {$ifdef DEBUG}
-  writeln('  FieldDefs.Count: ',FieldDefs.Count);
+  writeln('  FieldDefs.Count: ', FieldDefs.Count);
   {$endif}
 end;
 

packages/fcl-db/tests/testdbbasics.pas

@@ -30,6 +30,8 @@ type
     procedure TestCancelUpdDelete1;
     procedure TestCancelUpdDelete2;
     procedure TestBookmarks;
+    
+    procedure TestLocate;
 
     procedure TestFirst;
     procedure TestDelete1;
@@ -42,6 +44,8 @@ type
     procedure TestGetFieldValues;
 
     procedure TestAddIndex;
+    procedure TestAddDescIndex;
+    procedure TestAddCaseInsIndex;
     procedure TestInactSwitchIndex;
 
     procedure TestAddIndexInteger;
@@ -562,6 +566,28 @@ begin
     end;
 end;
 
+procedure TTestDBBasics.TestLocate;
+begin
+  with DBConnector.GetNDataset(true,13) do
+    begin
+    open;
+    asserttrue(Locate('id',vararrayof([5]),[]));
+    AssertEquals(5,FieldByName('id').AsInteger);
+    AssertFalse(Locate('id',vararrayof([15]),[]));
+    asserttrue(Locate('id',vararrayof([12]),[]));
+    AssertEquals(12,FieldByName('id').AsInteger);
+    close;
+    open;
+    asserttrue(Locate('id',vararrayof([12]),[]));
+    AssertEquals(12,FieldByName('id').AsInteger);
+    asserttrue(Locate('id;name',vararrayof([4,'TestName4']),[]));
+    AssertEquals(4,FieldByName('id').AsInteger);
+
+    assertFalse(Locate('id;name',vararrayof([4,'TestName5']),[]));
+
+    end;
+end;
+
 procedure TTestDBBasics.TestSetFieldValues;
 var PassException : boolean;
 begin
@@ -886,7 +912,7 @@ begin
     
     if not ActiveDS then
       begin
-      AddIndex('testindex','F'+FieldTypeNames[AfieldType]);
+      AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
       IndexName:='testindex';
       end
     else
@@ -905,7 +931,7 @@ begin
       begin
       if not assigned(ds.FindField('F'+FieldTypeNames[AfieldType])) then
         Ignore('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset');
-      AddIndex('testindex','F'+FieldTypeNames[AfieldType]);
+      AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
       IndexName:='testindex';
       First;
       end;
@@ -978,13 +1004,100 @@ begin
     begin
 
     AFieldType:=ftString;
-    AddIndex('testindex','F'+FieldTypeNames[AfieldType]);
+    AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
+    FList := TStringList.Create;
+    FList.Sorted:=true;
+    FList.CaseSensitive:=True;
+    FList.Duplicates:=dupAccept;
+    open;
+
+    while not eof do
+      begin
+      flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+      Next;
+      end;
+
+    IndexName:='testindex';
+    first;
+    i:=0;
+
+    while not eof do
+      begin
+      AssertEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+      inc(i);
+      Next;
+      end;
+
+    while not bof do
+      begin
+      dec(i);
+      AssertEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+      Prior;
+      end;
+    end;
+end;
+
+procedure TTestDBBasics.TestAddDescIndex;
+var ds : TBufDataset;
+    AFieldType : TFieldType;
+    FList : TStringList;
+    i : integer;
+begin
+  ds := DBConnector.GetFieldDataset as TBufDataset;
+  with ds do
+    begin
+
+    AFieldType:=ftString;
+    AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'F'+FieldTypeNames[AfieldType]);
     FList := TStringList.Create;
     FList.Sorted:=true;
     FList.CaseSensitive:=True;
     FList.Duplicates:=dupAccept;
     open;
 
+    while not eof do
+      begin
+      flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+      Next;
+      end;
+
+    IndexName:='testindex';
+    first;
+    i:=FList.Count-1;
+
+    while not eof do
+      begin
+      AssertEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+      dec(i);
+      Next;
+      end;
+
+    while not bof do
+      begin
+      inc(i);
+      AssertEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+      Prior;
+      end;
+    end;
+end;
+
+procedure TTestDBBasics.TestAddCaseInsIndex;
+var ds : TBufDataset;
+    AFieldType : TFieldType;
+    FList : TStringList;
+    i : integer;
+begin
+  ds := DBConnector.GetFieldDataset as TBufDataset;
+  with ds do
+    begin
+
+    AFieldType:=ftString;
+    AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'','F'+FieldTypeNames[AfieldType]);
+    FList := TStringList.Create;
+    FList.Sorted:=true;
+    FList.Duplicates:=dupAccept;
+    open;
+
     while not eof do
       begin
       flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
@@ -1023,7 +1136,7 @@ begin
     begin
 
     AFieldType:=ftString;
-    AddIndex('testindex','F'+FieldTypeNames[AfieldType]);
+    AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
     IndexName:='testindex';
     open;
     IndexName:=''; // This should set the default index (default_order)
@@ -1066,7 +1179,7 @@ begin
     FieldByName('name').asstring := 'aA';
     post;
 
-    AddIndex('test','name');
+    AddIndex('test','name',[]);
 
     first;
     ds.IndexName:='test';
@@ -1163,7 +1276,7 @@ begin
   with ds do
     begin
     AFieldType:=ftString;
-    AddIndex('testindex','F'+FieldTypeNames[AfieldType]);
+    AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
     open;
 
     for i := 0 to (testValuesCount div 3) do
@@ -1208,7 +1321,7 @@ begin
   with ds do
     begin
 
-    AddIndex('testindex','F'+FieldTypeNames[ftString]+', F'+FieldTypeNames[ftInteger]);
+    AddIndex('testindex','F'+FieldTypeNames[ftString]+'; F'+FieldTypeNames[ftInteger],[]);
     FList := TStringList.Create;
     FList.Sorted:=true;
     FList.CaseSensitive:=True;
@@ -1258,7 +1371,7 @@ begin
   with ds do
     begin
     AFieldType:=ftString;
-    AddIndex('testindex','F'+FieldTypeNames[AfieldType]);
+    AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
     IndexName:='testindex';
     open;
     OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;

packages/fcl-db/tests/toolsunit.pas

@@ -86,7 +86,7 @@ const
   testCurrencyValues : Array[0..testValuesCount-1] of currency = (-100,-65.5,-54.34,-43.34,-2.50,-0.2,45.40,0.3,45.4,127,128,255,256,45,0.3,45.4,127,128,255,256,45,1234.56,43.23,43.43,99.88);
   testIntValues : Array[0..testValuesCount-1] of integer = (-maxInt,-maxInt+1,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt-1,MaxInt,100,130,150,-150,-132,234);
   testSmallIntValues : Array[0..testValuesCount-1] of smallint = (-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,100,110,120,130,150,-150,-132,234,231,42);
-  testLargeIntValues : Array[0..testValuesCount-1] of smallint = (-MaxSIntValue,-MaxSIntValue+1,-maxInt-1,-maxInt+1,-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,maxSmallint+1,MaxInt-1,MaxInt,MaxSIntValue-1,MaxSIntValue,235253244);
+  testLargeIntValues : Array[0..testValuesCount-1] of LargeInt = (-MaxSIntValue,-MaxSIntValue+1,-maxInt-1,-maxInt+1,-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,maxSmallint+1,MaxInt-1,MaxInt,MaxSIntValue-1,MaxSIntValue,235253244);
   testBooleanValues : Array[0..testValuesCount-1] of boolean = (true,false,false,true,true,false,false,true,false,true,true,true,false,false,false,false,true,true,true,true,false,true,true,false,false);
   testStringValues : Array[0..testValuesCount-1] of string = (
     '',