diff --git a/packages/fcl-db/src/base/bufdataset_parser.pp b/packages/fcl-db/src/base/bufdataset_parser.pp index 84b96b79c0..a4f5dab86b 100644 --- a/packages/fcl-db/src/base/bufdataset_parser.pp +++ b/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 diff --git a/packages/fcl-db/src/dbase/dbf_prscore.pas b/packages/fcl-db/src/dbase/dbf_prscore.pas index 2165f28d82..bd0963b939 100644 --- a/packages/fcl-db/src/dbase/dbf_prscore.pas +++ b/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)); diff --git a/packages/fcl-db/src/dbase/dbf_prsdef.pas b/packages/fcl-db/src/dbase/dbf_prsdef.pas index effa76b75b..40882b60d4 100644 --- a/packages/fcl-db/src/dbase/dbf_prsdef.pas +++ b/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.