* Adds methods to TBinaryField (getasvariant/setasvarvalue) Mantis #20532

git-svn-id: trunk@19656 -

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;
 

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

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;
 
 

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;

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 }