paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 00:09:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Ladislav Karrach (Lacak2) to make LocateOptions work for TBufDataset.Locate + test, bug #15725

Browse Source 
git-svn-id: trunk@15005 -
This commit is contained in:
joost 2010-03-12 17:12:28 +00:00
parent aebc2aea40
commit 33f9424d68
2 changed files with 27 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
packages/fcl-db/src/base/bufdataset.pas
View File

@ -532,9 +532,12 @@ begin
end;
function DBCompareText(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
begin
if loCaseInsensitive in options then
if [loCaseInsensitive,loPartialKey]=options then
Result := AnsiStrLIComp(pchar(subValue),pchar(aValue),length(pchar(subValue)))
else if [loPartialKey] = options then
Result := AnsiStrLComp(pchar(subValue),pchar(aValue),length(pchar(subValue)))
else if [loCaseInsensitive] = options then
Result := AnsiCompareText(pchar(subValue),pchar(aValue))
else
Result := AnsiCompareStr(pchar(subValue),pchar(aValue));
@ -2759,7 +2762,10 @@ begin
SetLength(DBCompareStruct,FieldsAmount);
for FieldNr:=0 to FieldsAmount-1 do
begin
ProcessFieldCompareStruct(TField(SearchFields[FieldNr]),DBCompareStruct[FieldNr]);
DBCompareStruct[FieldNr].Options:=options;
end;
finally
SearchFields.Free;
end;

19
packages/fcl-db/tests/testdbbasics.pas
View File

@ -38,6 +38,7 @@ type
procedure TestBookmarkValid;
procedure TestLocate;
procedure TestLocateCaseIns;
procedure TestFirst;
procedure TestDelete1;
@ -756,6 +757,24 @@ begin
end;
end;
procedure TTestDBBasics.TestLocateCaseIns;
begin
with DBConnector.GetNDataset(true,13) do
begin
open;
assertfalse(Locate('name',vararrayof(['TEstName5']),[]));
asserttrue(Locate('name',vararrayof(['TEstName5']),[loCaseInsensitive]));
AssertEquals(5,FieldByName('id').AsInteger);
assertfalse(Locate('name',vararrayof(['TestN']),[]));
asserttrue(Locate('name',vararrayof(['TestN']),[loPartialKey]));
assertfalse(Locate('name',vararrayof(['TestNA']),[loPartialKey]));
asserttrue(Locate('name',vararrayof(['TestNA']),[loPartialKey, loCaseInsensitive]));
close;
end;
end;
procedure TTestDBBasics.TestSetFieldValues;
var PassException : boolean;
begin