fcl-db: base:

- Add new properties for
 TField:
  .AsAnsiString, AsUnicodeString, AsUTF8String
 TParam:
  .AsAnsiString, AsUnicodeString, AsUTF8String
- Add CodePage to TStringField and TMemoField
  (so character fields are now CodePage aware, like AnsiString; default CodePage is CP_ACP=0)

git-svn-id: trunk@34098 -

packages/fcl-db/src/base/bufdataset.pas

@@ -2149,9 +2149,9 @@ begin
     ftUnknown    : result := 0;
     ftString,
       ftGuid,
-      ftFixedChar: result := FieldDef.Size + 1;
+      ftFixedChar: result := FieldDef.Size*FieldDef.CharSize + 1;
     ftFixedWideChar,
-      ftWideString:result := (FieldDef.Size + 1)*2;
+      ftWideString:result := (FieldDef.Size + 1)*FieldDef.CharSize;
     ftSmallint,
       ftInteger,
       ftAutoInc,

packages/fcl-db/src/base/dataset.inc

@@ -83,6 +83,8 @@ end;
 procedure TDataSet.BindFields(Binding: Boolean);
 
 var i, FieldIndex: Integer;
+    FieldDef: TFieldDef;
+    Field: TField;
 
 begin
   { FieldNo is set to -1 for calculated/lookup fields, to 0 for unbound field
@@ -90,39 +92,45 @@ begin
   FCalcFieldsSize := 0;
   FBlobFieldCount := 0;
   for i := 0 to Fields.Count - 1 do
-    with Fields[i] do
+    begin
+    Field := Fields[i];
+    Field.FFieldDef := Nil;
+    if not Binding then
+      Field.FFieldNo := 0
+    else if Field.FieldKind in [fkCalculated, fkLookup] then
       begin
-      FFieldDef:=Nil;
-      if not Binding then
-        FFieldNo := 0
-      else if FieldKind in [fkCalculated, fkLookup] then
-        begin
-        FFieldNo := -1;
-        FOffset := FCalcFieldsSize;
-        Inc(FCalcFieldsSize, DataSize + 1);
-        end
+      Field.FFieldNo := -1;
+      Field.FOffset := FCalcFieldsSize;
+      Inc(FCalcFieldsSize, Field.DataSize + 1);
+      end
+    else
+      begin
+      FieldIndex := FieldDefs.IndexOf(Field.FieldName);
+      if FieldIndex = -1 then
+        DatabaseErrorFmt(SFieldNotFound,[Field.FieldName],Self)
       else
         begin
-        FFieldDef := nil;
-        FieldIndex := FieldDefs.IndexOf(Fields[i].FieldName);
-        if FieldIndex = -1 then
-          DatabaseErrorFmt(SFieldNotFound,[Fields[i].FieldName],Self)
-        else
+        FieldDef := FieldDefs[FieldIndex];
+        Field.FFieldDef := FieldDef;
+        Field.FFieldNo := FieldDef.FieldNo;
+        if FieldDef.InternalCalcField then
+          FInternalCalcFields := True;
+        if Field.IsBlob then
           begin
-          FFieldDef := FieldDefs[FieldIndex];
-          FFieldNo := FFieldDef.FieldNo;
-          if FieldDef.InternalCalcField then
-            FInternalCalcFields := True;
-          if IsBlob then
-            begin
-            FSize := FFieldDef.Size;
-            FOffset := FBlobFieldCount;
-            Inc(FBlobFieldCount);
-            end;
-          end
+          Field.FSize := FieldDef.Size;
+          Field.FOffset := FBlobFieldCount;
+          Inc(FBlobFieldCount);
+          end;
+        // synchronize CodePage between TFieldDef and TField
+        // character data in record buffer and field buffer should have same CodePage
+        if Field is TStringField then
+          TStringField(Field).FCodePage := FieldDef.FCodePage
+        else if Field is TMemoField then
+          TMemoField(Field).FCodePage := FieldDef.FCodePage;
         end;
-      Bind(Binding);
       end;
+    Field.Bind(Binding);
+    end;
 end;
 
 function TDataSet.BookmarkAvailable: Boolean;
@@ -215,8 +223,8 @@ begin
   For I:=0 to FieldDefs.Count-1 do
     Writeln('Def ',I,' : ',Fielddefs.items[i].Name,'(',Fielddefs.items[i].FieldNo,')');
 {$endif}
-  For I:=0 to fielddefs.Count-1 do
-    With Fielddefs.Items[I] do
+  For I:=0 to FieldDefs.Count-1 do
+    With FieldDefs.Items[I] do
       If DataType<>ftUnknown then
         begin
         {$ifdef DSDebug}

packages/fcl-db/src/base/db.pas

@@ -42,7 +42,7 @@ type
   PLargeInt= ^LargeInt;
 
 { Auxiliary type }
-  TStringFieldBuffer = Array[0..dsMaxStringSize] of Char;
+  TStringFieldBuffer = Array[0..dsMaxStringSize] of AnsiChar;
 
 { Misc Dataset types }
 
@@ -164,13 +164,15 @@ type
 
   TFieldDef = class(TNamedItem)
   Private
+    FAttributes : TFieldAttributes;
+    FCodePage : TSystemCodePage;
     FDataType : TFieldType;
     FFieldNo : Longint;
     FInternalCalcField : Boolean;
     FPrecision : Longint;
     FRequired : Boolean;
     FSize : Integer;
-    FAttributes : TFieldAttributes;
+    function GetCharSize: Word;
     Function GetFieldClass : TFieldClass;
     procedure SetAttributes(AValue: TFieldAttributes);
     procedure SetDataType(AValue: TFieldType);
@@ -180,12 +182,14 @@ type
   public
     constructor Create(ACollection : TCollection); override;
     constructor Create(AOwner: TFieldDefs; const AName: string;
-      ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint); overload;
+      ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint;
+      ACodePage: TSystemCodePage = CP_ACP); overload;
     destructor Destroy; override;
     procedure Assign(APersistent: TPersistent); override;
     function CreateField(AOwner: TComponent): TField;
     property FieldClass: TFieldClass read GetFieldClass;
     property FieldNo: Longint read FFieldNo;
+    property CharSize: Word read GetCharSize;
     property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
     property Required: Boolean read FRequired write SetRequired;
   Published
@@ -208,6 +212,7 @@ type
   public
     constructor Create(ADataSet: TDataSet);
 //    destructor Destroy; override;
+    Function Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo : Integer; ACodePage:TSystemCodePage) : TFieldDef; overload;
     Function Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo : Integer) : TFieldDef; overload;
     procedure Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean); overload;
     procedure Add(const AName: string; ADataType: TFieldType; ASize: Word); overload;
@@ -338,6 +343,9 @@ type
     function GetAsVariant: variant; virtual;
     function GetOldValue: variant; virtual;
     function GetAsString: string; virtual;
+    function GetAsAnsiString: AnsiString; virtual;
+    function GetAsUnicodeString: UnicodeString; virtual;
+    function GetAsUTF8String: UTF8String; virtual;
     function GetAsWideString: WideString; virtual;
     function GetCanModify: Boolean; virtual;
     function GetClassDesc: String; virtual;
@@ -364,6 +372,9 @@ type
     procedure SetAsLargeInt(AValue: Largeint); virtual;
     procedure SetAsVariant(const AValue: variant); virtual;
     procedure SetAsString(const AValue: string); virtual;
+    procedure SetAsAnsiString(const AValue: AnsiString); virtual;
+    procedure SetAsUnicodeString(const AValue: UnicodeString); virtual;
+    procedure SetAsUTF8String(const AValue: UTF8String); virtual;
     procedure SetAsWideString(const AValue: WideString); virtual;
     procedure SetDataset(AValue : TDataset); virtual;
     procedure SetDataType(AValue: TFieldType);
@@ -398,6 +409,9 @@ type
     property AsLargeInt: LargeInt read GetAsLargeInt write SetAsLargeInt;
     property AsInteger: Longint read GetAsInteger write SetAsInteger;
     property AsString: string read GetAsString write SetAsString;
+    property AsAnsiString: AnsiString read GetAsAnsiString write SetAsAnsiString;
+    property AsUnicodeString: UnicodeString read GetAsUnicodeString write SetAsUnicodeString;
+    property AsUTF8String: UTF8String read GetAsUTF8String write SetAsUTF8String;
     property AsWideString: WideString read GetAsWideString write SetAsWideString;
     property AsVariant: variant read GetAsVariant write SetAsVariant;
     property AttributeSet: string read FAttributeSet write FAttributeSet;
@@ -456,6 +470,7 @@ type
 
   TStringField = class(TField)
   private
+    FCodePage      : TSystemCodePage;
     FFixedChar     : boolean;
     FTransliterate : Boolean;
   protected
@@ -465,22 +480,28 @@ type
     function GetAsFloat: Double; override;
     function GetAsInteger: Longint; override;
     function GetAsLargeInt: Largeint; override;
-    function GetAsString: string; override;
+    function GetAsString: String; override;
+    function GetAsAnsiString: AnsiString; override;
+    function GetAsUTF8String: UTF8String; override;
     function GetAsVariant: variant; override;
     function GetDataSize: Integer; override;
     function GetDefaultWidth: Longint; override;
     procedure GetText(var AText: string; ADisplayText: Boolean); override;
-    function GetValue(var AValue: string): Boolean;
+    function GetValue(out AValue: RawByteString): Boolean;
     procedure SetAsBoolean(AValue: Boolean); override;
     procedure SetAsDateTime(AValue: TDateTime); override;
     procedure SetAsFloat(AValue: Double); override;
     procedure SetAsInteger(AValue: Longint); override;
     procedure SetAsLargeInt(AValue: Largeint); override;
-    procedure SetAsString(const AValue: string); override;
+    procedure SetAsString(const AValue: String); override;
+    procedure SetAsAnsiString(const AValue: AnsiString); override;
+    procedure SetAsUTF8String(const AValue: UTF8String); override;
     procedure SetVarValue(const AValue: Variant); override;
+    procedure SetValue(AValue: RawByteString);
   public
     constructor Create(AOwner: TComponent); override;
     procedure SetFieldType(AValue: TFieldType); override;
+    property CodePage : TSystemCodePage read FCodePage;
     property FixedChar : Boolean read FFixedChar write FFixedChar;
     property Transliterate: Boolean read FTransliterate write FTransliterate;
     property Value: String read GetAsString write SetAsString;
@@ -495,7 +516,7 @@ type
   protected
     class procedure CheckTypeSize(AValue: Integer); override;
 
-    function GetValue(var AValue: WideString): Boolean;
+    function GetValue(out AValue: UnicodeString): Boolean;
 
     function GetAsString: string; override;
     procedure SetAsString(const AValue: string); override;
@@ -506,9 +527,15 @@ type
     function GetAsWideString: WideString; override;
     procedure SetAsWideString(const AValue: WideString); override;
 
+    function GetAsUnicodeString: UnicodeString; override;
+    procedure SetAsUnicodeString(const AValue: UnicodeString); override;
+
+    function GetAsUTF8String: UTF8String; override;
+    procedure SetAsUTF8String(const AValue: UTF8String); override;
+
     function GetDataSize: Integer; override;
   public
-    constructor Create(aOwner: TComponent); override;
+    constructor Create(AOwner: TComponent); override;
     procedure SetFieldType(AValue: TFieldType); override;
     property Value: WideString read GetAsWideString write SetAsWideString;
   end;
@@ -646,7 +673,7 @@ type
     function GetAsVariant: variant; override;
     function GetAsString: string; override;
     function GetDataSize: Integer; override;
-    procedure GetText(var theText: string; ADisplayText: Boolean); override;
+    procedure GetText(var AText: string; ADisplayText: Boolean); override;
     procedure SetAsBCD(const AValue: TBCD); override;
     procedure SetAsFloat(AValue: Double); override;
     procedure SetAsLargeInt(AValue: LargeInt); override;
@@ -712,7 +739,7 @@ type
     function GetAsString: string; override;
     function GetAsVariant: variant; override;
     function GetDataSize: Integer; override;
-    procedure GetText(var theText: string; ADisplayText: Boolean); override;
+    procedure GetText(var AText: string; ADisplayText: Boolean); override;
     procedure SetAsDateTime(AValue: TDateTime); override;
     procedure SetAsFloat(AValue: Double); override;
     procedure SetAsString(const AValue: string); override;
@@ -749,11 +776,9 @@ type
     function GetAsBytes: TBytes; override;
     function GetAsString: string; override;
     function GetAsVariant: Variant; override;
-    procedure GetText(var TheText: string; ADisplayText: Boolean); override;
     function GetValue(var AValue: TBytes): Boolean;
     procedure SetAsBytes(const AValue: TBytes); override;
     procedure SetAsString(const AValue: string); override;
-    procedure SetText(const AValue: string); override;
     procedure SetVarValue(const AValue: Variant); override;
   public
     constructor Create(AOwner: TComponent); override;
@@ -798,7 +823,7 @@ type
     function GetAsVariant: variant; override;
     function GetDataSize: Integer; override;
     function GetDefaultWidth: Longint; override;
-    procedure GetText(var TheText: string; ADisplayText: Boolean); override;
+    procedure GetText(var AText: string; ADisplayText: Boolean); override;
     procedure SetAsBCD(const AValue: TBCD); override;
     procedure SetAsFloat(AValue: Double); override;
     procedure SetAsInteger(AValue: Longint); override;
@@ -840,7 +865,7 @@ type
     function GetAsVariant: variant; override;
     function GetDataSize: Integer; override;
     function GetDefaultWidth: Longint; override;
-    procedure GetText(var TheText: string; ADisplayText: Boolean); override;
+    procedure GetText(var AText: string; ADisplayText: Boolean); override;
     procedure SetAsBCD(const AValue: TBCD); override;
     procedure SetAsFloat(AValue: Double); override;
     procedure SetAsLargeInt(AValue: LargeInt); override;
@@ -881,16 +906,17 @@ type
     procedure FreeBuffers; override;
     function GetAsBytes: TBytes; override;
     function GetAsString: string; override;
+    function GetAsAnsiString: AnsiString; override;
+    function GetAsUnicodeString: UnicodeString; override;
     function GetAsVariant: Variant; override;
-    function GetAsWideString: WideString; override;
     function GetBlobSize: Longint; virtual;
     function GetIsNull: Boolean; override;
-    procedure GetText(var TheText: string; ADisplayText: Boolean); override;
+    procedure GetText(var AText: string; ADisplayText: Boolean); override;
     procedure SetAsBytes(const AValue: TBytes); override;
     procedure SetAsString(const AValue: string); override;
-    procedure SetText(const AValue: string); override;
+    procedure SetAsAnsiString(const AValue: AnsiString); override;
+    procedure SetAsUnicodeString(const AValue: UnicodeString); override;
     procedure SetVarValue(const AValue: Variant); override;
-    procedure SetAsWideString(const AValue: WideString); override;
   public
     constructor Create(AOwner: TComponent); override;
     procedure Clear; override;
@@ -912,9 +938,15 @@ type
 { TMemoField }
 
   TMemoField = class(TBlobField)
+  private
+    FCodePage: TSystemCodePage;
   protected
-    function GetAsWideString: WideString; override;
-    procedure SetAsWideString(const AValue: WideString); override;
+    function GetAsAnsiString: AnsiString; override;
+    procedure SetAsAnsiString(const AValue: AnsiString); override;
+    function GetAsUnicodeString: UnicodeString; override;
+    procedure SetAsUnicodeString(const AValue: UnicodeString); override;
+    function GetAsUTF8String: UTF8String; override;
+    procedure SetAsUTF8String(const AValue: UTF8String); override;
   public
     constructor Create(AOwner: TComponent); override;
   published
@@ -927,9 +959,12 @@ type
   protected
     function GetAsVariant: Variant; override;
     procedure SetVarValue(const AValue: Variant); override;
-
     function GetAsString: string; override;
     procedure SetAsString(const AValue: string); override;
+    function GetAsAnsiString: AnsiString; override;
+    procedure SetAsAnsiString(const AValue: AnsiString); override;
+    function GetAsUTF8String: UTF8String; override;
+    procedure SetAsUTF8String(const AValue: UTF8String); override;
   public
     constructor Create(aOwner: TComponent); override;
     property Value: WideString read GetAsWideString write SetAsWideString;
@@ -1163,6 +1198,10 @@ type
     Function GetAsLargeInt: LargeInt;
     Function GetAsMemo: string;
     Function GetAsString: string;
+    Function GetAsAnsiString: AnsiString;
+    Function GetAsUnicodeString: UnicodeString;
+    Function GetAsUTF8String: UTF8String;
+    Function GetAsWideString: WideString;
     Function GetAsVariant: Variant;
     Function GetAsFMTBCD: TBCD;
     Function GetDisplayName: string; override;
@@ -1181,14 +1220,16 @@ type
     Procedure SetAsMemo(const AValue: string);
     Procedure SetAsSmallInt(AValue: LongInt);
     Procedure SetAsString(const AValue: string);
+    Procedure SetAsAnsiString(const AValue: AnsiString);
+    Procedure SetAsUTF8String(const AValue: UTF8String);
+    Procedure SetAsUnicodeString(const AValue: UnicodeString);
+    Procedure SetAsWideString(const AValue: WideString);
     Procedure SetAsTime(const AValue: TDateTime);
     Procedure SetAsVariant(const AValue: Variant);
     Procedure SetAsWord(AValue: LongInt);
     Procedure SetAsFMTBCD(const AValue: TBCD);
     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;
@@ -1196,7 +1237,7 @@ type
     Procedure AssignField(Field: TField);
     Procedure AssignToField(Field: TField);
     Procedure AssignFieldValue(Field: TField; const AValue: Variant);
-    procedure AssignFromField(Field : TField);
+    Procedure AssignFromField(Field : TField);
     Procedure Clear;
     Procedure GetData(Buffer: Pointer);
     Function  GetDataSize: Integer;
@@ -1217,6 +1258,9 @@ type
     Property AsMemo : string read GetAsMemo write SetAsMemo;
     Property AsSmallInt : LongInt read GetAsInteger write SetAsSmallInt;
     Property AsString : string read GetAsString write SetAsString;
+    Property AsAnsiString : AnsiString read GetAsAnsiString write SetAsAnsiString;
+    Property AsUTF8String: UTF8String read GetAsUTF8String write SetAsUTF8String;
+    Property AsUnicodeString: UnicodeString read GetAsUnicodeString write SetAsUnicodeString;
     Property AsTime : TDateTime read GetAsDateTime write SetAsTime;
     Property AsWord : LongInt read GetAsInteger write SetAsWord;
     Property AsFMTBCD: TBCD read GetAsFMTBCD write SetAsFMTBCD;

packages/fcl-db/src/base/dsparams.inc

@@ -528,7 +528,7 @@ begin
     Result:=FValue;
 end;
 
-function TParam.GetAsBytes: TBytes;
+Function TParam.GetAsBytes: TBytes;
 begin
   if IsNull then
     Result:=nil
@@ -607,7 +607,28 @@ begin
     Result:=FValue;
 end;
 
-function TParam.GetAsWideString: WideString;
+Function TParam.GetAsAnsiString: AnsiString;
+begin
+  Result := GetAsString;
+end;
+
+Function TParam.GetAsUnicodeString: UnicodeString;
+begin
+  if IsNull then
+    Result := ''
+  else
+    Result := FValue;
+end;
+
+Function TParam.GetAsUTF8String: UTF8String;
+begin
+  if IsNull then
+    Result := ''
+  else
+    Result := FValue;
+end;
+
+Function TParam.GetAsWideString: WideString;
 begin
   if IsNull then
     Result := ''
@@ -623,7 +644,7 @@ begin
     Result:=FValue;
 end;
 
-function TParam.GetAsFMTBCD: TBCD;
+Function TParam.GetAsFMTBCD: TBCD;
 begin
   If IsNull then
     Result:=0
@@ -655,7 +676,7 @@ begin
           and (FValue=AValue.FValue);
 end;
 
-procedure TParam.SetAsBCD(const AValue: Currency);
+Procedure TParam.SetAsBCD(const AValue: Currency);
 begin
   FDataType:=ftBCD;
   Value:=AValue;
@@ -673,7 +694,7 @@ begin
   Value:=AValue;
 end;
 
-procedure TParam.SetAsBytes(const AValue: TBytes);
+Procedure TParam.SetAsBytes(const AValue: TBytes);
 begin
   FDataType:=ftVarBytes;
   Value:=AValue;
@@ -735,11 +756,32 @@ begin
   Value:=AValue;
 end;
 
-procedure TParam.SetAsWideString(const aValue: WideString);
+Procedure TParam.SetAsAnsiString(const AValue: AnsiString);
+begin
+  if FDataType <> ftFixedChar then
+    FDataType := ftString;
+  Value:=AValue;
+end;
+
+Procedure TParam.SetAsUTF8String(const AValue: UTF8String);
+begin
+  if FDataType <> ftFixedChar then
+    FDataType := ftString;
+  Value:=AValue;
+end;
+
+Procedure TParam.SetAsUnicodeString(const AValue: UnicodeString);
+begin
+  if FDataType <> ftFixedWideChar then
+    FDataType := ftWideString;
+  Value := AValue;
+end;
+
+Procedure TParam.SetAsWideString(const AValue: WideString);
 begin
   if FDataType <> ftFixedWideChar then
     FDataType := ftWideString;
-  Value := aValue;
+  Value := AValue;
 end;
 
 
@@ -786,7 +828,7 @@ begin
   Value:=AValue;
 end;
 
-procedure TParam.SetAsFMTBCD(const AValue: TBCD);
+Procedure TParam.SetAsFMTBCD(const AValue: TBCD);
 begin
   FDataType:=ftFMTBcd;
   FValue:=VarFmtBCDCreate(AValue);
@@ -859,7 +901,7 @@ begin
     end
 end;
 
-procedure TParam.AssignToField(Field : TField);
+Procedure TParam.AssignToField(Field : TField);
 
 begin
   if Assigned(Field) then
@@ -888,13 +930,15 @@ begin
       ftBytes,
       ftVarBytes : Field.AsVariant:=Value;
       ftFmtBCD   : Field.AsBCD:=AsFMTBCD;
+      ftFixedWideChar,
+      ftWideString: Field.AsWideString:=AsWideString;
     else
       If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
         DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
     end;
 end;
 
-procedure TParam.AssignFromField(Field : TField);
+Procedure TParam.AssignFromField(Field : TField);
 
 begin
   if Assigned(Field) then
@@ -926,6 +970,8 @@ begin
       ftBytes,
       ftVarBytes : Value:=Field.AsVariant;
       ftFmtBCD   : AsFMTBCD:=Field.AsBCD;
+      ftFixedWideChar,
+      ftWideString: AsWideString:=Field.AsWideString;
     else
       If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
         DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
@@ -989,7 +1035,7 @@ begin
     ftFixedChar:
       begin
       S:=AsString;
-      StrMove(PChar(Buffer),Pchar(S),Length(S)+1);
+      StrMove(PChar(Buffer),PChar(S),Length(S)+1);
       end;
     ftWideString,
     ftWideMemo: begin