Patch from Luiz Americo:

 * Improve Master/Detail: the foreign key is automatically set when a new record is appended
 * Improve Locate/LocateNext: implements loCaseInsensitive and loPartialKey options
 * Better error handling. When executing a mal formed query or trying to open a invalid file an exception with a meaningful message
 * General code cleanup

git-svn-id: trunk@9870 -

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

@@ -104,6 +104,7 @@ type
     FSqlList:TStrings;
     procedure CopyCacheToItem(AItem: PDataRecord);
     function GetIndexFields(Value: Integer): TField;
+    procedure SetMasterIndexValue;
     procedure UpdateIndexFields;
     function FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoResync:Boolean):PDataRecord;
   protected
@@ -139,11 +140,11 @@ type
     procedure SetDetailFilter;
     procedure MasterChanged(Sender: TObject);
     procedure MasterDisabled(Sender: TObject);
-    procedure SetMasterFields(Value:String);
+    procedure SetMasterFields(const Value:String);
     function GetMasterFields:String;
     procedure SetMasterSource(Value: TDataSource);
     function GetMasterSource:TDataSource;
-    procedure SetFileName(Value: String);
+    procedure SetFileName(const Value: String);
     function GetRowsAffected:Integer; virtual;abstract;
     //TDataSet overrides
     function AllocRecordBuffer: PChar; override;
@@ -396,21 +397,21 @@ begin
   New(FCacheItem);
   New(FEndItem);
   
-  FBeginItem^.Previous:=nil;
-  FEndItem^.Next:=nil;
+  FBeginItem^.Previous := nil;
+  FEndItem^.Next := nil;
   
-  FBeginItem^.BookMarkFlag:=bfBOF;
-  FEndItem^.BookMarkFlag:=bfEOF;
+  FBeginItem^.BookMarkFlag := bfBOF;
+  FEndItem^.BookMarkFlag := bfEOF;
   
-  FMasterLink:=TMasterDataLink.Create(Self);
-  FMasterLink.OnMasterChange:=@MasterChanged;
-  FMasterLink.OnMasterDisable:=@MasterDisabled;
-  FIndexFieldList:=TList.Create;
+  FMasterLink := TMasterDataLink.Create(Self);
+  FMasterLink.OnMasterChange := @MasterChanged;
+  FMasterLink.OnMasterDisable := @MasterDisabled;
+  FIndexFieldList := TList.Create;
   BookmarkSize := SizeOf(Pointer);
-  FUpdatedItems:= TFPList.Create;
-  FAddedItems:= TFPList.Create;
-  FDeletedItems:= TFPList.Create;
-  FSqlList:=TStringList.Create;
+  FUpdatedItems := TFPList.Create;
+  FAddedItems := TFPList.Create;
+  FDeletedItems := TFPList.Create;
+  FSqlList := TStringList.Create;
   inherited Create(AOwner);
 end;
 
@@ -526,9 +527,15 @@ end;
 
 function TCustomSqliteDataset.GetIndexFields(Value: Integer): TField;
 begin
-  if (Value < 0) or (Value > FIndexFieldList.Count - 1) then
-    DatabaseError('Error acessing IndexFields: Index out of bonds',Self);
-  Result:= TField(FIndexFieldList[Value]);
+  Result := TField(FIndexFieldList[Value]);
+end;
+
+procedure TCustomSqliteDataset.SetMasterIndexValue;
+var
+  i: Integer;
+begin
+  for i := 0 to FIndexFieldList.Count - 1 do
+    TField(FIndexFieldList[i]).AsString := TField(FMasterLink.Fields[i]).AsString;
 end;
 
 procedure TCustomSqliteDataset.DisposeLinkedList;
@@ -695,11 +702,14 @@ var
   NewItem: PDataRecord;
 begin
   {$ifdef DEBUG_SQLITEDS}
-  if PPDataRecord(Buffer)^ <> FCacheItem then
-    DatabaseError('PPDataRecord(Buffer) <> FCacheItem - Problem',Self);
+  if PPDataRecord(ActiveBuffer)^ <> FCacheItem then
+    DatabaseError('PPDataRecord(ActiveBuffer) <> FCacheItem - Problem',Self);
   {$endif}
   New(NewItem);
   GetMem(NewItem^.Row,FRowBufferSize);
+  //if is a detail dataset then set the index value
+  if FMasterLink.Active then
+    SetMasterIndexValue;
   //necessary to nullify the Row before copy the cache
   FillChar(NewItem^.Row^,FRowBufferSize,#0);
   CopyCacheToItem(NewItem);
@@ -750,8 +760,6 @@ var
   TempItem:PDataRecord;
   ValError,TempInteger:Integer;
 begin
-  if FRecordCount = 0 then
-    Exit;
   Dec(FRecordCount);
   TempItem:=PPDataRecord(ActiveBuffer)^;
   TempItem^.Next^.Previous:=TempItem^.Previous;
@@ -824,12 +832,10 @@ procedure TCustomSqliteDataset.InternalOpen;
 var
   i:Integer;
 begin
-  if MasterSource <> nil then
+  if FMasterLink.DataSource <> nil then
   begin
     //todo: retrieve only necessary fields
     FSql := 'Select * from '+FTableName+';'; // forced to obtain all fields
-    FMasterLink.FieldNames:=FMasterLink.FieldNames; //workaround to fill MasterLinks.Fields
-    //if FMasterLink.Fields.Count = 0 MasterChanged will not be called anyway so ignore it
   end;
 
   if FSql = '' then
@@ -876,7 +882,7 @@ end;
 procedure TCustomSqliteDataset.InternalPost;
 begin
   if State <> dsEdit then
-    InternalAddRecord(ActiveBuffer,True)
+    InternalAddRecord(nil, True)
   else
   begin
     CopyCacheToItem(FInternalActiveBuffer);
@@ -897,23 +903,62 @@ begin
    Result := FDataAllocated;
 end;
 
+type
+  TLocateCompareFunction = function (Value, Key: PChar): Boolean;
+  
+  TLocateFieldInfo = record
+    Index: Integer;
+    Key: String;
+    CompFunction: TLocateCompareFunction;
+  end;
+
+function CompInsensitivePartial(Value, Key: PChar): Boolean;
+begin
+  if Value <> nil then
+    Result := StrLIComp(Value, Key, StrLen(Key)) = 0
+  else
+    Result := False;
+end;
+
+function CompSensitivePartial(Value, Key: PChar): Boolean;
+begin
+  if Value <> nil then
+    Result := StrLComp(Value, Key, StrLen(Key)) = 0
+  else
+    Result := False;
+end;
+
+function CompInsensitive(Value, Key: PChar): Boolean;
+begin
+  if Value <> nil then
+    Result := StrIComp(Value, Key) = 0
+  else
+    Result := False;
+end;
+
+function CompSensitive(Value, Key: PChar): Boolean;
+begin
+  if Value <> nil then
+    Result := StrComp(Value, Key) = 0
+  else
+    Result := False;
+end;
+
 function TCustomSqliteDataset.FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoResync:Boolean):PDataRecord;
 var
-  ValueArray: array of string;
-  IndexArray: array of integer;
+  LocateFields: array of TLocateFieldInfo;
   AFieldList: TList;
-  i,AFieldCount:Integer;
+  i, AFieldCount: Integer;
   MatchRecord: Boolean;
-  AValue:String;
-  TempItem:PDataRecord;
+  AValue: String;
+  TempItem: PDataRecord;
+  
 begin
-  Result:=nil;
-  CheckBrowseMode;
-  // Currently ignore options
-  AFieldList:=TList.Create;
+  Result := nil;
+  AFieldList := TList.Create;
   try
-    GetFieldList(AFieldList,KeyFields);
-    AFieldCount:=AFieldList.Count;
+    GetFieldList(AFieldList, KeyFields);
+    AFieldCount := AFieldList.Count;
     if AFieldCount > 1 then
     begin
       if VarIsArray(KeyValues) then
@@ -925,75 +970,98 @@ begin
         DatabaseError('Wrong number of values specified: expected an array of variants got a variant',Self);
     end;
     
-    //set the array of values and indexes
-
-    SetLength(ValueArray,AFieldCount);
-    SetLength(IndexArray,AFieldCount);
-    for i:= 0 to AFieldCount - 1 do
+    //set the array of the fields info
+    SetLength(LocateFields, AFieldCount);
+    
+    for i := 0 to AFieldCount - 1 do
       with TField(AFieldList[i]) do
       begin
-        //get float types in appropriate format
         if not (DataType in [ftFloat,ftDateTime,ftTime,ftDate]) then
         begin
+          //the loPartialKey and loCaseInsensitive is ignored in numeric fields
+          if DataType in [ftString, ftMemo] then
+          begin
+            if loPartialKey in Options then
+            begin
+              if loCaseInsensitive in Options then
+                LocateFields[i].CompFunction := @CompInsensitivePartial
+              else
+                LocateFields[i].CompFunction := @CompSensitivePartial;
+            end
+            else
+            begin
+              if loCaseInsensitive in Options then
+                LocateFields[i].CompFunction := @CompInsensitive
+              else
+                LocateFields[i].CompFunction := @CompSensitive;
+            end;
+          end
+          else
+            LocateFields[i].CompFunction := @CompSensitive;
+            
           if VarIsArray(KeyValues) then
-            ValueArray[i]:=keyvalues[i]
+            LocateFields[i].Key := KeyValues[i]
           else
-            ValueArray[i]:=keyvalues;
+            LocateFields[i].Key := KeyValues;
         end
         else
         begin
+          LocateFields[i].CompFunction := @CompSensitive;
+          //get float types in appropriate format
           if VarIsArray(KeyValues) then
-            Str(VarToDateTime(keyvalues[i]),AValue)
+            Str(VarToDateTime(keyvalues[i]), AValue)
           else
-            Str(VarToDateTime(keyvalues),AValue);
-          ValueArray[i]:=Trim(AValue);
+            Str(VarToDateTime(keyvalues), AValue);
+          LocateFields[i].Key := Trim(AValue);
         end;
-        IndexArray[i]:=FieldNo - 1;
+        LocateFields[i].Index := FieldNo - 1;
       end;
   finally
     AFieldList.Destroy;
   end;
   {$ifdef DEBUG_SQLITEDS}
   writeln('##TCustomSqliteDataset.FindRecordItem##');
-  writeln('  KeyFields: ',keyfields);
-  writeln('  KeyValues: ',keyvalues);
-  writeln('  AValue: ',AValue);
+  writeln('  KeyFields: ', KeyFields);
+  for i := 0 to AFieldCount - 1 do
+  begin
+    writeln('LocateFields[',i,']');
+    writeln('  Key: ', LocateFields[i].Key);
+    writeln('  Index: ', LocateFields[i].Index);
+  end;
   {$endif}        
   //Search the list
-  TempItem:=StartItem;
+  TempItem := StartItem;
   while TempItem <> FEndItem do
   begin
-    MatchRecord:=True;
+    MatchRecord := True;
     for i:= 0 to AFieldCount - 1 do
     begin
-      //todo: handle null values??
-      if (TempItem^.Row[IndexArray[i]] = nil) or
-        (StrComp(TempItem^.Row[IndexArray[i]],PChar(ValueArray[i])) <> 0) then
+      with LocateFields[i] do
+      if not CompFunction(TempItem^.Row[Index], PChar(Key)) then
       begin
-        MatchRecord:= False;
+        MatchRecord := False;
         Break;//for
       end;
     end;
     if MatchRecord then
     begin
-      Result:=TempItem;
+      Result := TempItem;
       if DoResync then
       begin
-        FCurrentItem:=TempItem;
+        FCurrentItem := TempItem;
         Resync([]);
       end;
       Break;//while
     end;
-    TempItem:=TempItem^.Next;
+    TempItem := TempItem^.Next;
   end;      
 end;
 
 procedure TCustomSqliteDataset.GetSqliteHandle;
 begin
   if FFileName = '' then
-    DatabaseError ('Filename not set',Self);
-  //todo:Handle opening non db files
-  FSqliteHandle:=InternalGetHandle;
+    DatabaseError('Filename not set',Self);
+  FSqliteHandle := InternalGetHandle;
 end;
 
 procedure TCustomSqliteDataset.FreeItem(AItem: PDataRecord);
@@ -1008,23 +1076,26 @@ end;
 
 function TCustomSqliteDataset.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : Boolean;
 begin
-  Result:=FindRecordItem(FBeginItem^.Next,KeyFields,KeyValues,Options,True) <> nil;  
+  CheckBrowseMode;
+  Result := FindRecordItem(FBeginItem^.Next, KeyFields, KeyValues, Options, True) <> nil;
 end;
   
 function TCustomSqliteDataset.LocateNext(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : Boolean;
 begin
-  Result:=FindRecordItem(PPDataRecord(ActiveBuffer)^^.Next,KeyFields,KeyValues,Options,True) <> nil;
+  CheckBrowseMode;
+  Result := FindRecordItem(PPDataRecord(ActiveBuffer)^^.Next, KeyFields, KeyValues, Options, True) <> nil;
 end;
   
 function TCustomSqliteDataset.Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;
 var
-  TempItem:PDataRecord;
+  TempItem: PDataRecord;
 begin
-  TempItem:=FindRecordItem(FBeginItem^.Next,KeyFields,KeyValues,[],False);
+  CheckBrowseMode;
+  TempItem := FindRecordItem(FBeginItem^.Next, KeyFields, KeyValues, [], False);
   if TempItem <> nil then
-    Result:=TempItem^.Row[FieldByName(ResultFields).FieldNo - 1]
+    Result := TempItem^.Row[FieldByName(ResultFields).FieldNo - 1]
   else
-    Result:=False;      
+    Result := False;
 end;  
 
 procedure TCustomSqliteDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
@@ -1058,10 +1129,8 @@ var
   TempStr:String;
 begin
   if not (State in [dsEdit, dsInsert]) then
-  begin
     DatabaseErrorFmt(SNotEditing,[Name],Self);
-    Exit;
-  end;
+
   StrDispose(FCacheItem^.Row[Pred(Field.FieldNo)]);
   if Buffer <> nil then
   begin
@@ -1178,7 +1247,7 @@ begin
   RefetchData;
 end;
 
-procedure TCustomSqliteDataset.SetMasterFields(Value: String);
+procedure TCustomSqliteDataset.SetMasterFields(const Value: String);
 begin
   FMasterLink.FieldNames:=Value;
   if Active and FMasterLink.Active then
@@ -1213,7 +1282,7 @@ begin
   Result := FMasterLink.DataSource;
 end;
 
-procedure TCustomSqliteDataset.SetFileName(Value: String);
+procedure TCustomSqliteDataset.SetFileName(const Value: String);
 begin
   if Value <> FFileName then
   begin
@@ -1513,12 +1582,8 @@ end;
 
 function TCustomSqliteDataset.TableExists(const ATableName: String): Boolean;
 begin
-  Result:=False;
-  if not (ATableName = '') and FileExists(FFileName) then
-  begin
-    ExecSql('SELECT name FROM SQLITE_MASTER WHERE type = ''table'' AND name LIKE '''+ ATableName+ ''';');
-    Result:=FReturnCode = SQLITE_ROW;
-  end;
+  ExecSql('SELECT name FROM SQLITE_MASTER WHERE type = ''table'' AND name LIKE '''+ ATableName+ ''';');
+  Result := FReturnCode = SQLITE_ROW;
 end;
 
 function TCustomSqliteDataset.UpdatesPending: Boolean;

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

@@ -63,6 +63,43 @@ implementation
 
 uses
   sqlite3,db;
+  
+function SqliteCode2Str(Code: Integer): String;
+begin
+  case Code of
+    SQLITE_OK           : Result := 'SQLITE_OK';
+    SQLITE_ERROR        : Result := 'SQLITE_ERROR';
+    SQLITE_INTERNAL     : Result := 'SQLITE_INTERNAL';
+    SQLITE_PERM         : Result := 'SQLITE_PERM';
+    SQLITE_ABORT        : Result := 'SQLITE_ABORT';
+    SQLITE_BUSY         : Result := 'SQLITE_BUSY';
+    SQLITE_LOCKED       : Result := 'SQLITE_LOCKED';
+    SQLITE_NOMEM        : Result := 'SQLITE_NOMEM';
+    SQLITE_READONLY     : Result := 'SQLITE_READONLY';
+    SQLITE_INTERRUPT    : Result := 'SQLITE_INTERRUPT';
+    SQLITE_IOERR        : Result := 'SQLITE_IOERR';
+    SQLITE_CORRUPT      : Result := 'SQLITE_CORRUPT';
+    SQLITE_NOTFOUND     : Result := 'SQLITE_NOTFOUND';
+    SQLITE_FULL         : Result := 'SQLITE_FULL';
+    SQLITE_CANTOPEN     : Result := 'SQLITE_CANTOPEN';
+    SQLITE_PROTOCOL     : Result := 'SQLITE_PROTOCOL';
+    SQLITE_EMPTY        : Result := 'SQLITE_EMPTY';
+    SQLITE_SCHEMA       : Result := 'SQLITE_SCHEMA';
+    SQLITE_TOOBIG       : Result := 'SQLITE_TOOBIG';
+    SQLITE_CONSTRAINT   : Result := 'SQLITE_CONSTRAINT';
+    SQLITE_MISMATCH     : Result := 'SQLITE_MISMATCH';
+    SQLITE_MISUSE       : Result := 'SQLITE_MISUSE';
+    SQLITE_NOLFS        : Result := 'SQLITE_NOLFS';
+    SQLITE_AUTH         : Result := 'SQLITE_AUTH';
+    SQLITE_FORMAT       : Result := 'SQLITE_FORMAT';
+    SQLITE_RANGE        : Result := 'SQLITE_RANGE';
+    SQLITE_ROW          : Result := 'SQLITE_ROW';
+    SQLITE_NOTADB       : Result := 'SQLITE_NOTADB';
+    SQLITE_DONE         : Result := 'SQLITE_DONE';
+  else
+    Result:='Unknown Return Value';
+  end;
+end;
 
 function GetAutoIncValue(NextValue: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl;
 var
@@ -95,8 +132,23 @@ end;
 
 
 function TSqlite3Dataset.InternalGetHandle: Pointer;
+const
+  CheckFileSql = 'Select Name from sqlite_master LIMIT 1';
+var
+  vm: Pointer;
+  ErrorStr: String;
 begin
-  FReturnCode:=sqlite3_open(PChar(FFileName),@Result);
+  sqlite3_open(PChar(FFileName), @Result);
+  //sqlite3_open returns SQLITE_OK even for invalid files
+  //do additional check here
+  FReturnCode := sqlite3_prepare(Result, CheckFileSql, -1, @vm, nil);
+  if FReturnCode <> SQLITE_OK then
+  begin
+    ErrorStr := SqliteCode2Str(FReturnCode) + ' - ' + sqlite3_errmsg(Result);;
+    sqlite3_close(Result);
+    DatabaseError(ErrorStr, Self);
+  end;
+  sqlite3_finalize(vm);
 end;
 
 procedure TSqlite3Dataset.InternalInitFieldDefs;
@@ -111,7 +163,9 @@ begin
   {$endif}
   FAutoIncFieldNo:=-1;
   FieldDefs.Clear;
-  sqlite3_prepare(FSqliteHandle,PChar(FSql),-1,@vm,nil);
+  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);
   //Set BufferSize
@@ -256,40 +310,7 @@ end;
 
 function TSqlite3Dataset.ReturnString: String;
 begin
- case FReturnCode of
-      SQLITE_OK           : Result := 'SQLITE_OK';
-      SQLITE_ERROR        : Result := 'SQLITE_ERROR';
-      SQLITE_INTERNAL     : Result := 'SQLITE_INTERNAL';
-      SQLITE_PERM         : Result := 'SQLITE_PERM';
-      SQLITE_ABORT        : Result := 'SQLITE_ABORT';
-      SQLITE_BUSY         : Result := 'SQLITE_BUSY';
-      SQLITE_LOCKED       : Result := 'SQLITE_LOCKED';
-      SQLITE_NOMEM        : Result := 'SQLITE_NOMEM';
-      SQLITE_READONLY     : Result := 'SQLITE_READONLY';
-      SQLITE_INTERRUPT    : Result := 'SQLITE_INTERRUPT';
-      SQLITE_IOERR        : Result := 'SQLITE_IOERR';
-      SQLITE_CORRUPT      : Result := 'SQLITE_CORRUPT';
-      SQLITE_NOTFOUND     : Result := 'SQLITE_NOTFOUND';
-      SQLITE_FULL         : Result := 'SQLITE_FULL';
-      SQLITE_CANTOPEN     : Result := 'SQLITE_CANTOPEN';
-      SQLITE_PROTOCOL     : Result := 'SQLITE_PROTOCOL';
-      SQLITE_EMPTY        : Result := 'SQLITE_EMPTY';
-      SQLITE_SCHEMA       : Result := 'SQLITE_SCHEMA';
-      SQLITE_TOOBIG       : Result := 'SQLITE_TOOBIG';
-      SQLITE_CONSTRAINT   : Result := 'SQLITE_CONSTRAINT';
-      SQLITE_MISMATCH     : Result := 'SQLITE_MISMATCH';
-      SQLITE_MISUSE       : Result := 'SQLITE_MISUSE';
-      SQLITE_NOLFS        : Result := 'SQLITE_NOLFS';
-      SQLITE_AUTH         : Result := 'SQLITE_AUTH';
-      SQLITE_FORMAT       : Result := 'SQLITE_FORMAT';
-      SQLITE_RANGE        : Result := 'SQLITE_RANGE';
-      SQLITE_ROW          : Result := 'SQLITE_ROW';
-      SQLITE_NOTADB       : Result := 'SQLITE_NOTADB';
-      SQLITE_DONE         : Result := 'SQLITE_DONE';
-  else
-    Result:='Unknow Return Value';
- end;
- Result:=Result+' - '+sqlite3_errmsg(FSqliteHandle);
+  Result := SqliteCode2Str(FReturnCode) + ' - ' + sqlite3_errmsg(FSqliteHandle);
 end;
 
 function TSqlite3Dataset.GetSqliteVersion: String;

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

@@ -97,8 +97,15 @@ begin
 end;
 
 function TSqliteDataset.InternalGetHandle: Pointer;
+var
+  ErrorStr: PChar;
 begin
-  Result:=sqlite_open(PChar(FFileName),0,nil);
+  Result := sqlite_open(PChar(FFileName), 0, @ErrorStr);
+  if Result = nil then
+  begin
+    DatabaseError('Error opening "' + FFileName +'": ' + StrPas(ErrorStr));
+    sqlite_freemem(ErrorStr);
+  end;
 end;
 
 procedure TSqliteDataset.InternalInitFieldDefs;
@@ -111,7 +118,9 @@ var
 begin
   FieldDefs.Clear;
   FAutoIncFieldNo := -1;
-  sqlite_compile(FSqliteHandle,PChar(FSql),nil,@vm,nil);
+  FReturnCode := sqlite_compile(FSqliteHandle,PChar(FSql),nil,@vm,nil);
+  if FReturnCode <> SQLITE_OK then
+    DatabaseError(ReturnString, Self);
   sqlite_step(vm,@ColumnCount,@ColumnValues,@ColumnNames);
   //Prepare the array of pchar2sql functions
   SetLength(FGetSqlStr,ColumnCount);