Patch (adapted) from Thorsten Engler:

 * Added TWideStringField, TGUIDField, TVariantField
 * Published TCurrencyField.Currency
 * TBlobField.GetAsString/SetAsString only calls ReadBuffer if size>0

git-svn-id: trunk@6879 -

packages/fcl-db/src/db.pas

@@ -110,10 +110,10 @@ type
   TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
     ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate,  ftTime, ftDateTime,
     ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
-    ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
+    ftParadoxOle, ftDBaseOle, ftTypedBinary, ftWideMemo, ftCursor, ftFixedChar,
     ftWideString, ftLargeint, ftADT, ftArray, ftReference,
     ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
-    ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd);
+    ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftFixedWideChar);
 
 { Part of DBCommon, but temporary defined here (bug 8206) }
 
@@ -324,6 +324,7 @@ type
     function GetAsVariant: variant; virtual;
     function GetOldValue: variant; virtual;
     function GetAsString: string; virtual;
+    function GetAsWideString: WideString; virtual;
     function GetCanModify: Boolean; virtual;
     function GetClassDesc: String; virtual;
     function GetDataSize: Word; virtual;
@@ -347,6 +348,7 @@ type
     procedure SetAsLargeint(AValue: Largeint); virtual;
     procedure SetAsVariant(AValue: variant); virtual;
     procedure SetAsString(const AValue: string); virtual;
+    procedure SetAsWideString(const aValue: WideString); virtual;
     procedure SetDataType(AValue: TFieldType);
     procedure SetNewValue(const AValue: Variant);
     procedure SetSize(AValue: Word); virtual;
@@ -377,6 +379,7 @@ type
     property AsLargeInt: LargeInt read GetAsLargeInt write SetAsLargeInt;
     property AsInteger: Integer read GetAsInteger write SetAsInteger;
     property AsString: string read GetAsString write SetAsString;
+    property AsWideString: WideString read GetAsWideString write SetAsWideString;
     property AsVariant: variant read GetAsVariant write SetAsVariant;
     property AttributeSet: string read FAttributeSet write FAttributeSet;
     property Calculated: Boolean read FCalculated write FCalculated;
@@ -459,6 +462,30 @@ type
     property Size default 20;
   end;
 
+{ TWideStringField }
+
+  TWideStringField = class(TStringField)
+  protected
+    class procedure CheckTypeSize(aValue: Integer); override;
+
+    function GetValue(var aValue: WideString): Boolean;
+
+    function GetAsString: string; override;
+    procedure SetAsString(const aValue: string); override;
+
+    function GetAsVariant: Variant; override;
+    procedure SetVarValue(const aValue: Variant); override;
+
+    function GetAsWideString: WideString; override;
+    procedure SetAsWideString(const aValue: WideString); override;
+
+    function GetDataSize: Word; override;
+  public
+    constructor Create(aOwner: TComponent); override;
+    property Value: WideString read GetAsWideString write SetAsWideString;
+  end;
+
+
 { TNumericField }
   TNumericField = class(TField)
   Private
@@ -593,7 +620,7 @@ type
     property Value: Double read GetAsFloat write SetAsFloat;
 
   published
-    property Currency: Boolean read FCurrency write SetCurrency;
+    property Currency: Boolean read FCurrency write SetCurrency default False;
     property MaxValue: Double read FMaxValue write FMaxValue;
     property MinValue: Double read FMinValue write FMinValue;
     property Precision: Longint read FPrecision write FPrecision default 15;
@@ -604,6 +631,8 @@ type
   TCurrencyField = class(TFloatField)
   public
     constructor Create(AOwner: TComponent); override;
+  published
+    property Currency default True;
   end;
 
 { TBooleanField }
@@ -742,7 +771,7 @@ type
 
 { TBlobField }
   TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
-  TBlobType = ftBlob..ftTypedBinary;
+  TBlobType = ftBlob..ftWideMemo;
 
   TBlobField = class(TField)
   private
@@ -762,6 +791,8 @@ type
     procedure SetAsString(const AValue: string); override;
     procedure SetText(const AValue: string); override;
     procedure SetVarValue(const AValue: Variant); override;
+    function GetAsWideString: WideString; override;
+    procedure SetAsWideString(const aValue: WideString); override;
   public
     constructor Create(AOwner: TComponent); override;
     procedure Assign(Source: TPersistent); override;
@@ -784,12 +815,31 @@ type
 { TMemoField }
 
   TMemoField = class(TBlobField)
+  protected
+    function GetAsWideString: WideString; override;
+    procedure SetAsWideString(const aValue: WideString); override;
   public
     constructor Create(AOwner: TComponent); override;
   published
     property Transliterate default True;
   end;
 
+{ TWideMemoField }
+
+  TWideMemoField = class(TBlobField)
+  protected
+    function GetAsVariant: Variant; override;
+    procedure SetVarValue(const AValue: Variant); override;
+
+    function GetAsString: string; override;
+    procedure SetAsString(const aValue: string); override;
+  public
+    constructor Create(aOwner: TComponent); override;
+    property Value: WideString read GetAsWideString write SetAsWideString;
+  published
+  end;
+
+
 { TGraphicField }
 
   TGraphicField = class(TBlobField)
@@ -797,6 +847,52 @@ type
     constructor Create(AOwner: TComponent); override;
   end;
 
+{ TVariantField }
+
+  TVariantField = class(TField)
+  protected
+    class procedure CheckTypeSize(aValue: Integer); override;
+
+    function GetAsBoolean: Boolean; override;
+    procedure SetAsBoolean(aValue: Boolean); override;
+
+    function GetAsDateTime: TDateTime; override;
+    procedure SetAsDateTime(aValue: TDateTime); override;
+
+    function GetAsFloat: Double; override;
+    procedure SetAsFloat(aValue: Double); override;
+
+    function GetAsInteger: Longint; override;
+    procedure SetAsInteger(aValue: Longint); override;
+
+    function GetAsString: string; override;
+    procedure SetAsString(const aValue: string); override;
+
+    function GetAsWideString: WideString; override;
+    procedure SetAsWideString(const aValue: WideString); override;
+
+    function GetAsVariant: Variant; override;
+    procedure SetVarValue(const aValue: Variant); override;
+
+    function GetDefaultWidth: Integer; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
+{ TGuidField }
+
+  TGuidField = class(TStringField)
+  protected
+    class procedure CheckTypeSize(AValue: Longint); override;
+    function GetDefaultWidth: Longint; override;
+
+    function GetAsGuid: TGUID;
+    procedure SetAsGuid(const aValue: TGUID);
+  public
+    constructor Create(AOwner: TComponent); override;
+    property AsGuid: TGUID read GetAsGuid write SetAsGuid;
+  end;
+
 { TIndexDef }
 
   TIndexDefs = class;
@@ -1593,6 +1689,8 @@ type
     Procedure SetAsWord(AValue: LongInt);
     Procedure SetDataType(AValue: TFieldType);
     Procedure SetText(const AValue: string);
+    function GetAsWideString: WideString;
+    procedure SetAsWideString(const aValue: WideString);
   public
     constructor Create(ACollection: TCollection); overload; override;
     constructor Create(AParams: TParams; AParamType: TParamType); reintroduce; overload;
@@ -1627,6 +1725,7 @@ type
     Property NativeStr : string read FNativeStr write FNativeStr;
     Property Text : string read GetAsString write SetText;
     Property Value : Variant read GetAsVariant write SetAsVariant stored IsParamStored;
+    property AsWideString: WideString read GetAsWideString write SetAsWideString;
   published
     Property DataType : TFieldType read FDataType write SetDataType;
     Property Name : string read FName write FName;
@@ -1691,7 +1790,8 @@ const
     varDate, varDate, varDate, varOleStr, varOleStr, varInteger, varOleStr,
     varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varError,
     varOleStr, varOleStr, varError, varError, varError, varError, varError,
-    varOleStr, varOleStr, varVariant, varUnknown, varDispatch, varOleStr, varOleStr,varOleStr);
+    varOleStr, varOleStr, varVariant, varUnknown, varDispatch, varOleStr,
+    varOleStr,varOleStr, varOleStr,varOleStr);
 
 
 Const
@@ -1734,7 +1834,9 @@ Const
       'IDispatch',
       'Guid',
       'TimeStamp',
-      'FMTBcd'
+      'FMTBcd',
+      'FixedWideChar',
+      'WideMemo'
     );
     { 'Unknown',
       'String',
@@ -1779,13 +1881,14 @@ const
       { ftBlob} TBlobField,
       { ftMemo} TMemoField,
       { ftGraphic} TGraphicField,
-      { ftFmtMemo} TMemoField,
+      { ftFmtMemo} TBlobField,
       { ftParadoxOle} TBlobField,
       { ftDBaseOle} TBlobField,
       { ftTypedBinary} TBlobField,
+      { ftWideMemo} TWideMemoField,
       { ftCursor} Nil,
       { ftFixedChar} TStringField,
-      { ftWideString} Nil,
+      { ftWideString} TWideStringField,
       { ftLargeint} TLargeIntField,
       { ftADT} Nil,
       { ftArray} Nil,
@@ -1793,12 +1896,13 @@ const
       { ftDataSet} Nil,
       { ftOraBlob} TBlobField,
       { ftOraClob} TMemoField,
-      { ftVariant} Nil,
+      { ftVariant} TVariantField,
       { ftInterface} Nil,
       { ftIDispatch} Nil,
-      { ftGuid} Nil,
+      { ftGuid} TGuidField,
       { ftTimeStamp} Nil,
-      { ftFMTBcd} Nil
+      { ftFMTBcd} Nil,
+      { ftFixedWideString} TWideStringField
     );
 
   dsEditModes = [dsEdit, dsInsert, dsSetKey];

packages/fcl-db/src/dsparams.inc

@@ -533,6 +533,15 @@ begin
     Result:=FValue;
 end;
 
+function TParam.GetAsWideString: WideString;
+begin
+  if IsNull then
+    Result := ''
+  else
+    Result := FValue;
+end;
+
+
 Function TParam.GetAsVariant: Variant;
 begin
   if IsNull then
@@ -629,9 +638,18 @@ end;
 Procedure TParam.SetAsString(const AValue: string);
 begin
   FValue:=AValue;
-  FDataType:=ftString;
+  if FDataType <> ftFixedChar then
+    FDataType := ftString;
+end;
+
+procedure TParam.SetAsWideString(const aValue: WideString);
+begin
+  FValue := aValue;
+  if FDataType <> ftFixedWideChar then
+    FDataType := ftWideString;
 end;
 
+
 Procedure TParam.SetAsTime(const AValue: TDateTime);
 begin
   FValue:=AValue;
@@ -816,18 +834,26 @@ Procedure TParam.AssignFieldValue(Field: TField; const AValue: Variant);
 begin
   If Assigned(Field) then
     begin
+
     if (Field.DataType = ftString) and TStringField(Field).FixedChar then
-      DataType:=ftFixedChar
+      DataType := ftFixedChar
     else if (Field.DataType = ftMemo) and (Field.Size > 255) then
-      DataType:=ftString
+      DataType := ftString
+    else if (Field.DataType = ftWideString) and TWideStringField(Field).FixedChar then
+      DataType := ftFixedWideChar
+    else if (Field.DataType = ftWideMemo) and (Field.Size > 255) then
+      DataType := ftWideString
     else
-      DataType:=Field.DataType;
+      DataType := Field.DataType;
+
     if VarIsNull(AValue) then
       Clear
     else
       Value:=AValue;
+
     Size:=Field.DataSize;
     FBound:=True;
+
     end;
 end;
 
@@ -839,9 +865,10 @@ end;
 Procedure TParam.GetData(Buffer: Pointer);
 
 Var
-  P : Pointer;
-  S : String;
-
+  P  : Pointer;
+  S  : String;
+  ws : WideString;
+  l  : Integer;
 begin
   case FDataType of
     ftUnknown  : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
@@ -860,6 +887,15 @@ begin
       S:=AsString;
       StrMove(PChar(Buffer),Pchar(S),Length(S)+1);
       end;
+    ftWideString,
+    ftWideMemo: begin
+      ws := GetAsWideString;
+      l := Length(ws);
+      if l > 0 then
+        Move(ws[1], Buffer, Succ(l)*2)
+      else
+        PWideChar(Buffer)^ := #0
+    end;
     ftTime     : PInteger(Buffer)^:=DateTimeToTimeStamp(AsTime).Time;
     ftDate     : PInteger(Buffer)^:=DateTimeToTimeStamp(AsTime).Date;
     ftDateTime : PDouble(Buffer)^:=TimeStampToMSecs(DateTimeToTimeStamp(AsDateTime));

packages/fcl-db/src/fields.inc

@@ -329,12 +329,12 @@ begin
           Error;
       vtAnsiString:
         AsString := string(VAnsiString);
-//      vtCurrency:
-//        AsCurrency := VCurrency^;
+      vtCurrency:
+        AsCurrency := VCurrency^;
       vtVariant:
         if not VarIsClear(VVariant^) then Self.Value := VVariant^;
       vtWideString:
-        AsString := WideString(VWideString);
+        AsWideString := WideString(VWideString);
       vtInt64:
         Self.Value := VInt64^;
     else
@@ -425,6 +425,11 @@ begin
   Result := GetClassDesc;
 end;
 
+function TField.GetAsWideString: WideString;
+begin
+  Result := GetAsString;
+end;
+
 function TField.GetOldValue: Variant;
 
 var SaveState : TDatasetState;
@@ -746,6 +751,12 @@ begin
   Raise AccessError(SString);
 end;
 
+procedure TField.SetAsWideString(const aValue: WideString);
+begin
+  SetAsString(aValue);
+end;
+
+
 procedure TField.SetData(Buffer: Pointer);
 
 begin
@@ -789,7 +800,7 @@ end;
 procedure TField.SetFieldType(AValue: TFieldType);
 
 begin
-  //!! To be implemented
+  { empty }
 end;
 
 procedure TField.SetParentComponent(AParent: TComponent);
@@ -1079,6 +1090,91 @@ begin
   SetAsString(AValue);
 end;
 
+{ ---------------------------------------------------------------------
+    TWideStringField
+  ---------------------------------------------------------------------}
+
+class procedure TWideStringField.CheckTypeSize(aValue: Integer);
+begin
+  if aValue <= 0 then
+    DatabaseErrorFmt(SInvalidFieldSize,[aValue]);
+end;
+
+constructor TWideStringField.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  SetDataType(ftWideString);
+end;
+
+function TWideStringField.GetValue(var aValue: WideString): Boolean;
+var
+  FixBuffer : array[0..dsMaxStringSize div 2] of WideChar;
+  DynBuffer : array of WideChar;
+  Buffer    : PWideChar;
+begin
+  if DataSize <= dsMaxStringSize then begin
+    Result := GetData(@FixBuffer, False);
+    aValue := FixBuffer;
+  end else begin
+    SetLength(DynBuffer, Succ(Size));
+    Buffer := PWideChar(DynBuffer);
+    Result := GetData(Buffer, False);
+    if Result then
+      aValue := Buffer;
+  end;
+end;
+
+function TWideStringField.GetAsString: string;
+begin
+  Result := GetAsWideString;
+end;
+
+procedure TWideStringField.SetAsString(const aValue: string);
+begin
+  SetAsWideString(aValue);
+end;
+
+function TWideStringField.GetAsVariant: Variant;
+var
+  ws: WideString;
+begin
+  if GetValue(ws) then
+    Result := ws
+  else
+    Result := Null;
+end;
+
+procedure TWideStringField.SetVarValue(const aValue: Variant);
+begin
+  SetAsWideString(aValue);
+end;
+
+function TWideStringField.GetAsWideString: WideString;
+begin
+  if not GetValue(Result) then
+    Result := '';
+end;
+
+procedure TWideStringField.SetAsWideString(const aValue: WideString);
+const
+  NullWideChar : WideChar = #0;
+var
+  Buffer : PWideChar;
+begin
+  if Length(aValue)>0 then
+    Buffer := PWideChar(@aValue[1])
+  else
+    Buffer := @NullWideChar;
+  SetData(Buffer, False);
+end;
+
+function TWideStringField.GetDataSize: Word;
+begin
+  Result :=
+    (Size + 1) * 2;
+end;
+
+
 { ---------------------------------------------------------------------
     TNumericField
   ---------------------------------------------------------------------}
@@ -2175,14 +2271,37 @@ end;
 
 function TBlobField.GetAsString: string;
 var
-  Stream: TStream;
+  Stream : TStream;
+  Len    : Integer;
 begin
   Stream := GetBlobStream(bmRead);
   if Stream <> nil then
     With Stream do
       try
-        SetLength(Result,Size);
-        ReadBuffer(Pointer(Result)^,Size);
+        Len := Size;
+        SetLength(Result, Len);
+        if Len > 0 then
+          ReadBuffer(Result[1], Len);
+      finally
+        Free
+      end
+  else
+    Result := '';
+end;
+
+function TBlobField.GetAsWideString: WideString;
+var
+  Stream : TStream;
+  Len    : Integer;
+begin
+  Stream := GetBlobStream(bmRead);
+  if Stream <> nil then
+    With Stream do
+      try
+        Len := Size;
+        SetLength(Result,Len div 2);
+        if Len > 0 then
+          ReadBuffer(Result[1] ,Len);
       finally
         Free
       end
@@ -2244,11 +2363,29 @@ end;
 
 
 procedure TBlobField.SetAsString(const AValue: string);
+var
+  Len : Integer;
+begin
+  With GetBlobStream(bmwrite) do
+    try
+      Len := Length(Avalue);
+      if Len > 0 then
+        WriteBuffer(aValue[1], Len);
+    finally
+      Free;
+    end;
+end;
 
+
+procedure TBlobField.SetAsWideString(const AValue: WideString);
+var
+  Len : Integer;
 begin
   With GetBlobStream(bmwrite) do
     try
-      WriteBuffer(Pointer(Avalue)^,Length(Avalue));
+      Len := Length(Avalue) * 2;
+      if Len > 0 then
+        WriteBuffer(aValue[1], Len);
     finally
       Free;
     end;
@@ -2349,7 +2486,6 @@ begin
   end;
 end;
 
-
 procedure TBlobField.SetFieldType(AValue: TFieldType);
 
 begin
@@ -2357,8 +2493,6 @@ begin
     SetDatatype(Avalue);
 end;
 
-
-
 { TMemoField }
 
 constructor TMemoField.Create(AOwner: TComponent);
@@ -2368,6 +2502,51 @@ begin
   SetDataType(ftMemo);
 end;
 
+function TMemoField.GetAsWideString: WideString;
+begin
+  Result := GetAsString;
+end;
+
+procedure TMemoField.SetAsWideString(const aValue: WideString);
+begin
+  SetAsString(aValue);
+end;
+
+{ TWideMemoField }
+
+constructor TWideMemoField.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  SetDataType(ftWideMemo);
+end;
+
+function TWideMemoField.GetAsString: string;
+begin
+  Result := GetAsWideString;
+end;
+
+procedure TWideMemoField.SetAsString(const aValue: string);
+begin
+  SetAsWideString(aValue);
+end;
+
+function TWideMemoField.GetAsVariant: Variant;
+
+Var s : string;
+
+begin
+  if not GetIsNull then
+    begin
+    s := GetAsWideString;
+    result := s;
+    end
+  else result := Null;
+end;
+
+procedure TWideMemoField.SetVarValue(const AValue: Variant);
+begin
+  SetAsWideString(AValue);
+end;
 
 { TGraphicField }
 
@@ -2378,6 +2557,133 @@ begin
   SetDataType(ftGraphic);
 end;
 
+{ TGuidField }
+
+constructor TGuidField.Create(AOwner: TComponent);
+begin
+  Size := 38;
+  inherited Create(AOwner);
+  SetDataType(ftGuid);
+end;
+
+class procedure TGuidField.CheckTypeSize(AValue: LongInt);
+begin
+  if aValue <> 38 then
+    DatabaseErrorFmt(SInvalidFieldSize,[AValue]);
+end;
+
+function TGuidField.GetAsGuid: TGUID;
+const
+  nullguid: TGUID = '{00000000-0000-0000-0000-000000000000}';
+var
+  S: string;
+begin
+  S := GetAsString;
+  if S = '' then
+    Result := nullguid
+  else
+    Result := StringToGuid(S);
+end;
+
+function TGuidField.GetDefaultWidth: LongInt;
+begin
+  Result := 38;
+end;
+
+procedure TGuidField.SetAsGuid(const aValue: TGUID);
+begin
+  SetAsString(GuidToString(aValue));
+end;
+
+function TVariantField.GetDefaultWidth: Integer;
+begin
+  Result := 15;
+end;
+
+{ TVariantField }
+
+constructor TVariantField.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  SetDataType(ftVariant);
+end;
+
+class procedure TVariantField.CheckTypeSize(aValue: Integer);
+begin
+  { empty }
+end;
+
+function TVariantField.GetAsBoolean: Boolean;
+begin
+  Result := GetAsVariant;
+end;
+
+function TVariantField.GetAsDateTime: TDateTime;
+begin
+  Result := GetAsVariant;
+end;
+
+function TVariantField.GetAsFloat: Double;
+begin
+  Result := GetAsVariant;
+end;
+
+function TVariantField.GetAsInteger: Longint;
+begin
+  Result := GetAsVariant;
+end;
+
+function TVariantField.GetAsString: string;
+begin
+  Result := VarToStr(GetAsVariant);
+end;
+
+function TVariantField.GetAsWideString: WideString;
+begin
+  Result := VarToWideStr(GetAsVariant);
+end;
+
+function TVariantField.GetAsVariant: Variant;
+begin
+  if not GetData(@Result) then
+    Result := Null;
+end;
+
+procedure TVariantField.SetAsBoolean(aValue: Boolean);
+begin
+  SetVarValue(aValue);
+end;
+
+procedure TVariantField.SetAsDateTime(aValue: TDateTime);
+begin
+  SetVarValue(aValue);
+end;
+
+procedure TVariantField.SetAsFloat(aValue: Double);
+begin
+  SetVarValue(aValue);
+end;
+
+procedure TVariantField.SetAsInteger(aValue: Longint);
+begin
+  SetVarValue(aValue);
+end;
+
+procedure TVariantField.SetAsString(const aValue: string);
+begin
+  SetVarValue(aValue);
+end;
+
+procedure TVariantField.SetAsWideString(const aValue: WideString);
+begin
+  SetVarValue(aValue);
+end;
+
+procedure TVariantField.SetVarValue(const aValue: Variant);
+begin
+  SetData(@aValue);
+end;
+
 
 { TFields }
 

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -446,6 +446,7 @@ const TypeStrings : array[TFieldType] of string =
       'Unknown',
       'Unknown',
       'Unknown',
+      'Unknown',
       'int',
       'Unknown',
       'Unknown',
@@ -458,6 +459,7 @@ const TypeStrings : array[TFieldType] of string =
       'Unknown',
       'Unknown',
       'Unknown',
+      'Unknown',
       'Unknown'
     );