diff --git a/packages/fcl-db/src/base/db.pas b/packages/fcl-db/src/base/db.pas index a77162c8b6..3ef11d967e 100644 --- a/packages/fcl-db/src/base/db.pas +++ b/packages/fcl-db/src/base/db.pas @@ -324,6 +324,7 @@ type procedure FreeBuffers; virtual; function GetAsBCD: TBCD; virtual; function GetAsBoolean: Boolean; virtual; + function GetAsBytes: TBytes; virtual; function GetAsCurrency: Currency; virtual; function GetAsLargeInt: LargeInt; virtual; function GetAsDateTime: TDateTime; virtual; @@ -350,6 +351,7 @@ type procedure ReadState(Reader: TReader); override; procedure SetAsBCD(const AValue: TBCD); virtual; procedure SetAsBoolean(AValue: Boolean); virtual; + procedure SetAsBytes(const AValue: TBytes); virtual; procedure SetAsCurrency(AValue: Currency); virtual; procedure SetAsDateTime(AValue: TDateTime); virtual; procedure SetAsFloat(AValue: Double); virtual; @@ -384,6 +386,7 @@ type procedure Validate(Buffer: Pointer); property AsBCD: TBCD read GetAsBCD write SetAsBCD; property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean; + property AsBytes: TBytes read GetAsBytes write SetAsBytes; property AsCurrency: Currency read GetAsCurrency write SetAsCurrency; property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime; property AsFloat: Double read GetAsFloat write SetAsFloat; @@ -732,8 +735,11 @@ type TBinaryField = class(TField) protected class procedure CheckTypeSize(AValue: Longint); override; + function GetAsBytes: TBytes; override; function GetAsString: string; override; + function GetAsVariant: Variant; override; procedure GetText(var TheText: string; ADisplayText: Boolean); override; + procedure SetAsBytes(const AValue: TBytes); override; procedure SetAsString(const AValue: string); override; procedure SetText(const AValue: string); override; procedure SetVarValue(const AValue: Variant); override; @@ -1097,7 +1103,7 @@ type { TParam } - TBlobData = string; + TBlobData = AnsiString; // Delphi defines it as alias to TBytes TParamBinding = array of integer; diff --git a/packages/fcl-db/src/base/dsparams.inc b/packages/fcl-db/src/base/dsparams.inc index 9e45ef3799..90a9ba9f70 100644 --- a/packages/fcl-db/src/base/dsparams.inc +++ b/packages/fcl-db/src/base/dsparams.inc @@ -544,9 +544,20 @@ begin end; Function TParam.GetAsString: string; +var P: Pointer; begin If IsNull then Result:='' + else if (FDataType in [ftBytes, ftVarBytes]) and VarIsArray(FValue) then + begin + SetLength(Result, (VarArrayHighBound(FValue, 1) + 1) div SizeOf(Char)); + P := VarArrayLock(FValue); + try + Move(P^, Result[1], Length(Result) * SizeOf(Char)); + finally + VarArrayUnlock(FValue); + end; + end else Result:=FValue; end; @@ -706,6 +717,8 @@ begin else if VarIsFmtBCD(Value) then FDataType:=ftFmtBCD + else if VarIsArray(AValue) and (VarType(AValue) and varTypeMask = varByte) then + FDataType:=ftBytes else FDataType:=ftUnknown; end; @@ -818,7 +831,7 @@ begin ftDate, ftDateTime : Field.AsDateTime:=AsDateTime; ftBytes, - ftVarBytes : ; // Todo. + ftVarBytes : Field.AsVariant:=Value; ftFmtBCD : Field.AsBCD:=AsFMTBCD; else If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then @@ -856,7 +869,7 @@ begin ftDate, ftDateTime : AsDateTime:=Field.AsDateTime; ftBytes, - ftVarBytes : ; // Todo. + ftVarBytes : Value:=Field.AsVariant; ftFmtBCD : AsFMTBCD:=Field.AsBCD; else If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then diff --git a/packages/fcl-db/src/base/fields.inc b/packages/fcl-db/src/base/fields.inc index 96aa7f4a50..de57f1986a 100644 --- a/packages/fcl-db/src/base/fields.inc +++ b/packages/fcl-db/src/base/fields.inc @@ -290,6 +290,7 @@ Const SLargeInt = 'LargeInt'; SVariant = 'Variant'; SString = 'String'; + SBytes = 'Bytes'; constructor TField.Create(AOwner: TComponent); @@ -415,12 +416,23 @@ begin // TDataset manages the buffers. end; -function TField.GetAsBoolean: Boolean; +function TField.GetAsBCD: TBCD; +begin + raise AccessError(SBCD); +end; +function TField.GetAsBoolean: Boolean; begin raise AccessError(SBoolean); end; +function TField.GetAsBytes: TBytes; +begin + SetLength(Result, DataSize); + if not GetData(@Result[0], False) then + Result := nil; +end; + function TField.GetAsDateTime: TDateTime; begin @@ -617,11 +629,6 @@ begin Result:=-1; end; -function TField.GetAsBCD: TBCD; -begin - raise AccessError(SBCD); -end; - function TField.GetLookup: Boolean; begin Result := FieldKind = fkLookup; @@ -646,11 +653,6 @@ begin end; end; -procedure TField.SetAsBCD(const AValue: TBCD); -begin - Raise AccessError(SBCD); -end; - procedure TField.SetIndex(const AValue: Integer); begin if FFields <> nil then FFields.SetFieldIndex(Self, AValue) @@ -748,6 +750,16 @@ begin DataSet := TDataSet(Reader.Parent); end; +procedure TField.SetAsBCD(const AValue: TBCD); +begin + Raise AccessError(SBCD); +end; + +procedure TField.SetAsBytes(const AValue: TBytes); +begin + raise AccessError(SBytes); +end; + procedure TField.SetAsBoolean(AValue: Boolean); begin @@ -2172,12 +2184,40 @@ begin DatabaseErrorfmt(SInvalidFieldSize,[Avalue]); end; +function TBinaryField.GetAsBytes: TBytes; +begin + SetLength(Result, DataSize); + if not GetData(Pointer(Result), True) then + SetLength(Result, 0); +end; + function TBinaryField.GetAsString: string; - +var B: TBytes; begin - Setlength(Result,DataSize); - GetData(Pointer(Result)); + B := GetAsBytes; + if length(B) = 0 then + Result := '' + else + begin + SetLength(Result, length(B) div SizeOf(Char)); + Move(B[0], Result[1], length(Result) * SizeOf(Char)); + end; +end; + + +function TBinaryField.GetAsVariant: Variant; +var B: TBytes; + P: Pointer; +begin + B := GetAsBytes; + Result := VarArrayCreate([0, length(B)-1], varByte); + P := VarArrayLock(Result); + try + Move(B[0], P^, length(B)); + finally + VarArrayUnlock(Result); + end; end; @@ -2188,24 +2228,47 @@ begin end; -procedure TBinaryField.SetAsString(const AValue: string); - -Var Buf : PChar; - Allocated : Boolean; - +procedure TBinaryField.SetAsBytes(const AValue: TBytes); +var Buf: array[0..dsMaxStringSize] of byte; + DynBuf: TBytes; + Len: Word; + P: PByte; begin - Allocated:=False; - If Length(AVAlue)=DataSize then - Buf:=PChar(Avalue) - else - begin - GetMem(Buf,DataSize); - Move(Pchar(Avalue)[0],Buf^,DataSize); - Allocated:=True; + Len := Length(AValue); + if Len >= DataSize then + P := @AValue[0] + else begin + if DataSize <= dsMaxStringSize then + P := @Buf[0] + else begin + SetLength(DynBuf, DataSize); + P := @DynBuf[0]; end; - SetData(Buf); - If Allocated then - FreeMem(Buf,DataSize); + + if DataType = ftVarBytes then begin + Move(AValue[0], P[2], Len); + PWord(P)^ := Len; + end + else begin // ftBytes + Move(AValue[0], P^, Len); + FillChar(P[Len], DataSize-Len, 0); // right pad with #0 + end; + end; + SetData(P, True) +end; + + +procedure TBinaryField.SetAsString(const AValue: string); +var B : TBytes; +begin + If Length(AValue) = DataSize then + SetData(PChar(AValue)) + else + begin + SetLength(B, Length(AValue) * SizeOf(Char)); + Move(AValue[1], B[0], Length(B)); + SetAsBytes(B); + end; end; @@ -2216,8 +2279,24 @@ begin end; procedure TBinaryField.SetVarValue(const AValue: Variant); +var P: Pointer; + B: TBytes; + Len: integer; begin - SetAsString(Avalue); + if VarIsArray(AValue) then + begin + P := VarArrayLock(AValue); + try + Len := VarArrayHighBound(AValue, 1) + 1; + SetLength(B, Len); + Move(P^, B[0], Len); + finally + VarArrayUnlock(AValue); + end; + SetAsBytes(B); + end + else + SetAsString(AValue); end; diff --git a/packages/fcl-db/tests/testfieldtypes.pas b/packages/fcl-db/tests/testfieldtypes.pas index a2ec2a9351..4f62adf5ea 100644 --- a/packages/fcl-db/tests/testfieldtypes.pas +++ b/packages/fcl-db/tests/testfieldtypes.pas @@ -798,7 +798,7 @@ end; procedure TTestFieldTypes.TestBytesParamQuery; begin - TestXXParamQuery(ftBytes, FieldtypeDefinitions[ftBytes], testBytesValuesCount); + TestXXParamQuery(ftBytes, FieldtypeDefinitions[ftBytes], testBytesValuesCount, true); end; procedure TTestFieldTypes.TestStringParamQuery; @@ -858,7 +858,10 @@ begin Params.ParamByName('field1').AsDate := StrToDate(testDateValues[i],'yyyy/mm/dd','-'); ftDateTime:Params.ParamByName('field1').AsDateTime := StrToDateTime(testValues[ADataType,i], DBConnector.FormatSettings); ftFMTBcd : Params.ParamByName('field1').AsFMTBCD := StrToBCD(testFmtBCDValues[i],DBConnector.FormatSettings); - ftBytes : Params.ParamByName('field1').AsBlob := testBytesValues[i]; + ftBytes : if cross then + Params.ParamByName('field1').Value := StringToByteArray(testBytesValues[i]) + else + Params.ParamByName('field1').AsBlob := testBytesValues[i]; else AssertTrue('no test for paramtype available',False); end; diff --git a/packages/fcl-db/tests/toolsunit.pas b/packages/fcl-db/tests/toolsunit.pas index 0be734a063..6377ddd5a9 100644 --- a/packages/fcl-db/tests/toolsunit.pas +++ b/packages/fcl-db/tests/toolsunit.pas @@ -7,7 +7,7 @@ unit ToolsUnit; interface uses - Classes, SysUtils, DB, testdecorator, FmtBCD; + Classes, SysUtils, DB, testdecorator; Const MaxDataSet = 35; @@ -206,11 +206,12 @@ procedure FreeDBConnector; function DateTimeToTimeString(d: tdatetime) : string; function TimeStringToDateTime(d: String): TDateTime; +function StringToByteArray(s: ansistring): Variant; implementation uses - inifiles; + inifiles, FmtBCD, Variants; var DBConnectorRefCount: integer; @@ -374,6 +375,20 @@ begin result := ComposeDateTime(days,EncodeTime(hour,minute,second,millisecond)); end; +function StringToByteArray(s: ansistring): Variant; +var P: Pointer; + Len: integer; +begin + Len := Length(s) * SizeOf(AnsiChar); + Result := VarArrayCreate([0, Len-1], varByte); + P := VarArrayLock(Result); + try + Move(s[1], P^, Len); + finally + VarArrayUnlock(Result); + end; +end; + { TTestDataLink }