* Patch from Laco to implement filtering on null values

packages/fcl-db/src/base/bufdataset_parser.pp

@@ -65,10 +65,12 @@ type
   private
     FField: TField;
     FFieldName: string;
+    FFieldIsNull: boolean;
     FExprWord: TExprWord;
   protected
     function GetFieldVal: Pointer; virtual; abstract;
     function GetFieldType: TExpressionType; virtual; abstract;
+    function GetFieldIsNull: PBoolean;
   public
     constructor Create(UseField: TField);
 
@@ -78,6 +80,7 @@ type
     property FieldDef: TField read FField;
     property FieldType: TExpressionType read GetFieldType;
     property FieldName: string read FFieldName;
+    property FieldIsNull: PBoolean read GetFieldIsNull;
   end;
 
   TStringFieldVar = class(TFieldVar)
@@ -148,7 +151,6 @@ type
     procedure Refresh(Buffer: TRecordBuffer); override;
   end;
 
-
 //--TFieldVar----------------------------------------------------------------
 constructor TFieldVar.Create(UseField: TField);
 begin
@@ -160,6 +162,11 @@ begin
   FFieldName := UseField.FieldName;
 end;
 
+function TFieldVar.GetFieldIsNull: PBoolean;
+begin
+  Result := @FFieldIsNull;
+end;
+
 //--TStringFieldVar-------------------------------------------------------------
 function TStringFieldVar.GetFieldVal: Pointer;
 begin
@@ -188,7 +195,8 @@ end;
 procedure TStringFieldVar.Refresh(Buffer: TRecordBuffer);
 var Fieldbuf : TStringFieldBuffer;
 begin
-  if not FField.DataSet.GetFieldData(FField,@Fieldbuf) then
+  FFieldIsNull := not FField.DataSet.GetFieldData(FField,@Fieldbuf);
+  if FFieldIsNull  then
     FFieldVal^:=#0
   else
     strcopy(FFieldVal,@Fieldbuf[0]);
@@ -207,7 +215,8 @@ end;
 
 procedure TFloatFieldVar.Refresh(Buffer: TRecordBuffer);
 begin
-  if not FField.DataSet.GetFieldData(FField,@FFieldVal) then
+  FFieldIsNull := not FField.DataSet.GetFieldData(FField,@FFieldVal);
+  if FFieldIsNull then
     FFieldVal := 0;
 end;
 
@@ -224,7 +233,8 @@ end;
 
 procedure TIntegerFieldVar.Refresh(Buffer: TRecordBuffer);
 begin
-  if not FField.DataSet.GetFieldData(FField,@FFieldVal) then
+  FFieldIsNull := not FField.DataSet.GetFieldData(FField,@FFieldVal);
+  if FFieldIsNull then
     FFieldVal := 0;
 end;
 
@@ -241,7 +251,8 @@ end;
 
 procedure TLargeIntFieldVar.Refresh(Buffer: TRecordBuffer);
 begin
-  if not FField.DataSet.GetFieldData(FField,@FFieldVal) then
+  FFieldIsNull := not FField.DataSet.GetFieldData(FField,@FFieldVal);
+  if FFieldIsNull then
     FFieldVal := 0;
 end;
 
@@ -258,7 +269,8 @@ end;
 
 procedure TDateTimeFieldVar.Refresh(Buffer:TRecordBuffer );
 begin
-  if not FField.DataSet.GetFieldData(FField,@FFieldVal) then
+  FFieldIsNull := not FField.DataSet.GetFieldData(FField,@FFieldVal);
+  if FFieldIsNull then
     FFieldVal := 0;
 end;
 
@@ -275,17 +287,19 @@ end;
 
 procedure TBooleanFieldVar.Refresh(Buffer: TRecordBuffer);
 begin
-  if not FField.DataSet.GetFieldData(FField,@FFieldVal) then
+  FFieldIsNull := not FField.DataSet.GetFieldData(FField,@FFieldVal);
+  if FFieldIsNull then
     FFieldVal := False;
 end;
 
 procedure TBCDFieldVar.Refresh(Buffer: TRecordBuffer);
 var c: currency;
 begin
-  if FField.DataSet.GetFieldData(FField,@c) then
-    FFieldVal := c
+  FFieldIsNull := not FField.DataSet.GetFieldData(FField,@c);
+  if FFieldIsNull then
+    FFieldVal := 0
   else
-    FFieldVal := 0;
+    FFieldVal := c;
 end;
 
 
@@ -390,7 +404,7 @@ begin
     ftString, ftFixedChar:
       begin
       TempFieldVar := TStringFieldVar.Create(FieldInfo);
-      TempFieldVar.FExprWord := DefineStringVariable(VarName, TempFieldVar.FieldVal);
+      TempFieldVar.FExprWord := DefineStringVariable(VarName, TempFieldVar.FieldVal, TempFieldVar.FieldIsNull);
       TempFieldVar.FExprWord.fixedlen := Fieldinfo.Size;
       end;
     ftBoolean:
@@ -406,7 +420,7 @@ begin
     ftAutoInc, ftInteger, ftSmallInt, ftWord:
       begin
         TempFieldVar := TIntegerFieldVar.Create(FieldInfo);
-        TempFieldVar.FExprWord := DefineIntegerVariable(VarName, TempFieldVar.FieldVal);
+        TempFieldVar.FExprWord := DefineIntegerVariable(VarName, TempFieldVar.FieldVal, TempFieldVar.FieldIsNull);
       end;
     ftLargeInt:
       begin

packages/fcl-db/src/dbase/dbf_prscore.pas

@@ -85,14 +85,14 @@ type
     destructor Destroy; override;
 
     function DefineFloatVariable(AVarName: string; AValue: PDouble): TExprWord;
-    function DefineIntegerVariable(AVarName: string; AValue: PInteger): TExprWord;
+    function DefineIntegerVariable(AVarName: string; AValue: PInteger; AIsNull: PBoolean = nil): TExprWord;
 //    procedure DefineSmallIntVariable(AVarName: string; AValue: PSmallInt);
 {$ifdef SUPPORT_INT64}
     function DefineLargeIntVariable(AVarName: string; AValue: PLargeInt): TExprWord;
 {$endif}
     function DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec): TExprWord;
     function DefineBooleanVariable(AVarName: string; AValue: PBoolean): TExprWord;
-    function DefineStringVariable(AVarName: string; AValue: PPChar): TExprWord;
+    function DefineStringVariable(AVarName: string; AValue: PPChar; AIsNull: PBoolean = nil): TExprWord;
     function DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
         AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc): TExprWord;
     procedure Evaluate(AnExpression: string);
@@ -265,6 +265,8 @@ begin
       Args[0] := ExprWord.AsPointer;
       // store length as second parameter
       Args[1] := PChar(ExprWord.LenAsPointer);
+      // and NULL indicator as third parameter
+      Args[2] := PChar(ExprWord.IsNullAsPointer);
     end;
   end;
 end;
@@ -501,6 +503,7 @@ begin
             etLargeInt:ExprWord := TLargeIntConstant.Create(PInt64(FExpResult)^);
 {$endif}
             etString:  ExprWord := TStringConstant.Create(FExpResult);
+            etUnknown: ExprWord := TNullConstant.Create;
             else raise EParserException.CreateFmt('No support for resulttype %d. Please fix the TDBF code.',[ResultType]);
           end;
 
@@ -778,6 +781,8 @@ begin
 end;
 
 procedure TCustomExpressionParser.ParseString(AnExpression: string; DestCollection: TExprCollection);
+const
+  NullWord='NULL';
 var
   isConstant: Boolean;
   I, I1, I2, Len, DecSep: Integer;
@@ -971,6 +976,13 @@ begin
       DestCollection.Add(TempWord);
       FConstantsList.Add(TempWord);
     end
+    else if UpCase(W) = NullWord then
+    begin
+      // NULL
+      TempWord := TNullConstant.Create;
+      DestCollection.Add(TempWord);
+      FConstantsList.Add(TempWord);
+    end
     else if Length(W) > 0 then
       if FWordsList.Search(PChar(W), I) then
       begin
@@ -1132,9 +1144,9 @@ begin
   FWordsList.Add(Result);
 end;
 
-function TCustomExpressionParser.DefineIntegerVariable(AVarName: string; AValue: PInteger): TExprWord;
+function TCustomExpressionParser.DefineIntegerVariable(AVarName: string; AValue: PInteger; AIsNull: PBoolean): TExprWord;
 begin
-  Result := TIntegerVariable.Create(AVarName, AValue);
+  Result := TIntegerVariable.Create(AVarName, AValue, AIsNull);
   FWordsList.Add(Result);
 end;
 
@@ -1166,9 +1178,9 @@ begin
   FWordsList.Add(Result);
 end;
 
-function TCustomExpressionParser.DefineStringVariable(AVarName: string; AValue: PPChar): TExprWord;
+function TCustomExpressionParser.DefineStringVariable(AVarName: string; AValue: PPChar; AIsNull: PBoolean): TExprWord;
 begin
-  Result := TStringVariable.Create(AVarName, AValue);
+  Result := TStringVariable.Create(AVarName, AValue, AIsNull);
   FWordsList.Add(Result);
 end;
 
@@ -1864,6 +1876,12 @@ begin
     Res.MemoryPos^^ := Char(AnsiStrComp(Args[0], Args[1]) >= 0);
 end;
 
+procedure Func_SU_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PBoolean(Args[0]+StrLen(Args[0])+1)^);
+end;
+
 procedure Func_FF_EQ(Param: PExpressionRec);
 begin
   with Param^ do
@@ -1941,6 +1959,11 @@ begin
   with Param^ do
     Res.MemoryPos^^ := Char(PInteger(Args[0])^  =  PInteger(Args[1])^);
 end;
+procedure Func_IU_EQ(Param: PExpressionRec);
+begin
+  with Param^ do
+    Res.MemoryPos^^ := Char(PBoolean(Args[0]+8)^);
+end;
 
 procedure Func_II_NEQ(Param: PExpressionRec);
 begin
@@ -2294,6 +2317,7 @@ initialization
     Add(TFunction.CreateOper('>=','FI', etBoolean, Func_FI_GTE, 80));
     Add(TFunction.CreateOper('<>','FI', etBoolean, Func_FI_NEQ, 80));
     Add(TFunction.CreateOper('=', 'II', etBoolean, Func_II_EQ , 80));
+    Add(TFunction.CreateOper('=', 'IU', etBoolean, Func_IU_EQ , 80));
     Add(TFunction.CreateOper('<', 'II', etBoolean, Func_II_LT , 80));
     Add(TFunction.CreateOper('>', 'II', etBoolean, Func_II_GT , 80));
     Add(TFunction.CreateOper('<=','II', etBoolean, Func_II_LTE, 80));
@@ -2337,6 +2361,7 @@ initialization
     Add(TFunction.CreateOper('>=','IL', etBoolean, Func_IL_GTE, 80));
     Add(TFunction.CreateOper('<>','IL', etBoolean, Func_IL_NEQ, 80));
 {$endif}
+    Add(TFunction.CreateOper('=', 'SU', etBoolean, Func_SU_EQ , 80));
 
     Add(TFunction.CreateOper('NOT', 'B',  etBoolean, Func_NOT, 85));
     Add(TFunction.CreateOper('AND', 'BB', etBoolean, Func_AND, 90));

packages/fcl-db/src/dbase/dbf_prsdef.pas

@@ -90,6 +90,8 @@ type
     ExprFunc: TExprFunc;
   end;
 
+  { TExprWord }
+
   TExprWord = class(TObject)
   private
     FName: string;
@@ -112,8 +114,9 @@ type
   public
     constructor Create(AName: string; AExprFunc: TExprFunc);
 
-    function LenAsPointer: PInteger; virtual;
     function AsPointer: PChar; virtual;
+    function LenAsPointer: PInteger; virtual;
+    function IsNullAsPointer: PBoolean; virtual;
     function IsFunction: Boolean; virtual;
 
     property ExprFunc: TExprFunc read FExprFunc;
@@ -225,14 +228,26 @@ type
     property Value: Boolean read FValue write FValue;
   end;
 
+  { TNullConstant }
+
+  TNullConstant = class(TConstant)
+  private
+  public
+    constructor Create;
+  end;
+
+  { TVariable }
+
   TVariable = class(TExprWord)
   private
     FResultType: TExpressionType;
+    FIsNull: PBoolean;
   protected
     function GetCanVary: Boolean; override;
     function GetResultType: TExpressionType; override;
   public
     constructor Create(AName: string; AVarType: TExpressionType; AExprFunc: TExprFunc);
+    function IsNullAsPointer: PBoolean; override;
   end;
 
   TFloatVariable = class(TVariable)
@@ -252,7 +267,7 @@ type
     function GetFixedLen: Integer; override;
     procedure SetFixedLen(NewLen: integer); override;
   public
-    constructor Create(AName: string; AValue: PPChar);
+    constructor Create(AName: string; AValue: PPChar; AIsNull: PBoolean);
 
     function LenAsPointer: PInteger; override;
     function AsPointer: PChar; override;
@@ -273,7 +288,7 @@ type
   private
     FValue: PInteger;
   public
-    constructor Create(AName: string; AValue: PInteger);
+    constructor Create(AName: string; AValue: PInteger; AIsNull: PBoolean);
 
     function AsPointer: PChar; override;
   end;
@@ -372,6 +387,7 @@ begin
     'F': Result := etFloat;
     'D': Result := etDateTime;
     'S': Result := etString;
+    'U': Result := etUnknown;
   else
     Result := etUnknown;
   end;
@@ -405,6 +421,10 @@ begin
     if length = -1 then
       length := StrLen(PPChar(Args[0])^);
     Res.Append(PPChar(Args[0])^, length);
+    // NULL indicator (placed after NULL terminated string)
+    length := StrLen(PPChar(Args[0])^)+1;
+    Res.AssureSpace(length+1);
+    PBoolean(Res.Memory^+length)^ := Assigned(Args[2]) and PBoolean(Args[2])^;
   end;
 end;
 
@@ -416,8 +436,10 @@ end;
 
 procedure _IntegerVariable(Param: PExpressionRec);
 begin
-  with Param^ do
+  with Param^ do begin
     PInteger(Res.MemoryPos^)^ := PInteger(Args[0])^;
+    PBoolean(Res.MemoryPos^+8)^ := Assigned(Args[2]) and PBoolean(Args[2])^; // NULL indicator
+  end;
 end;
 
 {
@@ -429,15 +451,18 @@ end;
 }
 
 {$ifdef SUPPORT_INT64}
-
 procedure _LargeIntVariable(Param: PExpressionRec);
 begin
   with Param^ do
     PLargeInt(Res.MemoryPos^)^ := PLargeInt(Args[0])^;
 end;
-
 {$endif}
 
+procedure _NullConstant(Param: PExpressionRec);
+begin
+  // NOP
+end;
+
 { TExpressionWord }
 
 constructor TExprWord.Create(AName: string; AExprFunc: TExprFunc);
@@ -536,6 +561,11 @@ begin
   Result := nil;
 end;
 
+function TExprWord.IsNullAsPointer: PBoolean;
+begin
+  Result := nil;
+end;
+
 function TExprWord.IsFunction: Boolean;
 begin
   Result := False;
@@ -665,6 +695,13 @@ begin
 end;
 {$endif}
 
+{ TNullConstant }
+
+constructor TNullConstant.Create;
+begin
+  inherited Create('NULL', etUnknown, _NullConstant);
+end;
+
 { TVariable }
 
 constructor TVariable.Create(AName: string; AVarType: TExpressionType; AExprFunc: TExprFunc);
@@ -684,6 +721,11 @@ begin
   Result := FResultType;
 end;
 
+function TVariable.IsNullAsPointer: PBoolean;
+begin
+  Result := FIsNull;
+end;
+
 { TFloatVariable }
 
 constructor TFloatVariable.Create(AName: string; AValue: PDouble);
@@ -699,7 +741,7 @@ end;
 
 { TStringVariable }
 
-constructor TStringVariable.Create(AName: string; AValue: PPChar);
+constructor TStringVariable.Create(AName: string; AValue: PPChar; AIsNull: PBoolean);
 begin
   // variable or fixed length?
   inherited Create(AName, etString, _StringVariable);
@@ -707,6 +749,7 @@ begin
   // store pointer to string
   FValue := AValue;
   FFixedLen := -1;
+  FIsNull := AIsNull;
 end;
 
 function TStringVariable.AsPointer: PChar;
@@ -744,10 +787,11 @@ end;
 
 { TIntegerVariable }
 
-constructor TIntegerVariable.Create(AName: string; AValue: PInteger);
+constructor TIntegerVariable.Create(AName: string; AValue: PInteger; AIsNull: PBoolean);
 begin
   inherited Create(AName, etInteger, _IntegerVariable);
   FValue := AValue;
+  FIsNull := AIsNull;
 end;
 
 function TIntegerVariable.AsPointer: PChar;
@@ -1070,6 +1114,7 @@ begin
   Inc(FMemoryPos^, Length);
   // null-terminate
   FMemoryPos^^ := #0;
+  Inc(FMemoryPos^);
 end;
 
 procedure TDynamicType.AppendInteger(Source: Integer);
@@ -1078,6 +1123,7 @@ begin
   AssureSpace(12);
   Inc(FMemoryPos^, GetStrFromInt(Source, FMemoryPos^));
   FMemoryPos^^ := #0;
+  Inc(FMemoryPos^);
 end;
 
 end.