diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas index 3751375cee..b6815b50ab 100644 --- a/packages/fcl-db/src/base/bufdataset.pas +++ b/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, diff --git a/packages/fcl-db/src/base/dataset.inc b/packages/fcl-db/src/base/dataset.inc index b27fb5cb57..597d17a629 100644 --- a/packages/fcl-db/src/base/dataset.inc +++ b/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} diff --git a/packages/fcl-db/src/base/db.pas b/packages/fcl-db/src/base/db.pas index 6855b72a16..46044fbdb4 100644 --- a/packages/fcl-db/src/base/db.pas +++ b/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; diff --git a/packages/fcl-db/src/base/dsparams.inc b/packages/fcl-db/src/base/dsparams.inc index b09830ee38..c10579e4de 100644 --- a/packages/fcl-db/src/base/dsparams.inc +++ b/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; + Value := AValue; +end; + +Procedure TParam.SetAsWideString(const AValue: WideString); +begin + if FDataType <> ftFixedWideChar then + FDataType := ftWideString; + 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 diff --git a/packages/fcl-db/src/base/fields.inc b/packages/fcl-db/src/base/fields.inc index ae5910227e..4a40a21b3a 100644 --- a/packages/fcl-db/src/base/fields.inc +++ b/packages/fcl-db/src/base/fields.inc @@ -28,15 +28,16 @@ end;} TFieldDef ---------------------------------------------------------------------} -Constructor TFieldDef.Create(ACollection : TCollection); +constructor TFieldDef.Create(ACollection: TCollection); begin Inherited Create(ACollection); FFieldNo:=Index+1; end; -Constructor TFieldDef.Create(AOwner: TFieldDefs; const AName: string; - ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint); +constructor TFieldDef.Create(AOwner: TFieldDefs; const AName: string; + ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint; + ACodePage: TSystemCodePage); begin {$ifdef dsdebug } @@ -49,9 +50,17 @@ begin FRequired:=ARequired; FPrecision:=-1; FFieldNo:=AFieldNo; + case FDataType of + ftString, ftFixedChar, ftMemo: + FCodePage := ACodePage; + ftWideString, ftFixedWideChar, ftWideMemo: + FCodePage := CP_UTF16; + else + FCodePage := 0; + end; end; -Destructor TFieldDef.Destroy; +destructor TFieldDef.Destroy; begin Inherited destroy; @@ -71,14 +80,16 @@ begin Size := fd.Size; Precision := fd.Precision; FRequired := fd.Required; + FCodePage := fd.FCodePage; finally Collection.EndUpdate; end; - end else - inherited Assign(APersistent); + end + else + inherited Assign(APersistent); end; -Function TFieldDef.CreateField(AOwner: TComponent): TField; +function TFieldDef.CreateField(AOwner: TComponent): TField; var TheField : TFieldClass; @@ -104,12 +115,16 @@ begin Writeln ('TFieldDef.CreateField : Trying to set dataset'); {$endif dsdebug} Result.Dataset:=TFieldDefs(Collection).Dataset; - If (Result is TFloatField) then - TFloatField(Result).Precision:=FPrecision; - if (Result is TBCDField) then - TBCDField(Result).Precision:=FPrecision; - if (Result is TFmtBCDField) then - TFmtBCDField(Result).Precision:=FPrecision; + if (Result is TStringField) then + TStringField(Result).FCodePage := FCodePage + else if (Result is TMemoField) then + TMemoField(Result).FCodePage := FCodePage + else if (Result is TFloatField) then + TFloatField(Result).Precision := FPrecision + else if (Result is TBCDField) then + TBCDField(Result).Precision := FPrecision + else if (Result is TFmtBCDField) then + TFmtBCDField(Result).Precision := FPrecision; except Result.Free; Raise; @@ -146,7 +161,7 @@ begin Changed(False); end; -Function TFieldDef.GetFieldClass : TFieldClass; +function TFieldDef.GetFieldClass: TFieldClass; begin //!! Should be owner as tdataset but that doesn't work ?? @@ -159,6 +174,21 @@ begin Result:=Nil; end; +function TFieldDef.GetCharSize: Word; +begin + case FDataType of + ftString, ftFixedChar: + case FCodePage of + CP_UTF8: Result := 4; + else Result := 1; + end; + ftWideString, ftFixedWideChar: + Result := 2; + else + Result := 0; + end; +end; + { --------------------------------------------------------------------- TFieldDefs ---------------------------------------------------------------------} @@ -222,9 +252,14 @@ begin Inherited Create(ADataset, Owner, FieldDefClass); end; +function TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Integer; ACodePage: TSystemCodePage): TFieldDef; +begin + Result:=FieldDefClass.Create(Self,AName,ADataType,ASize,ARequired,AFieldNo,ACodePage); +end; + function TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Integer): TFieldDef; begin - Result:=FieldDefClass.create(Self,AName,ADataType,ASize,ARequired,AFieldNo); + Result:=FieldDefClass.Create(Self,AName,ADataType,ASize,ARequired,AFieldNo); end; procedure TFieldDefs.Assign(FieldDefs: TFieldDefs); @@ -367,12 +402,14 @@ begin Assign(TPersistent(VObject)) else Error; - vtAnsiString: - AsString := string(VAnsiString); vtCurrency: AsCurrency := VCurrency^; vtVariant: if not VarIsClear(VVariant^) then Self.Value := VVariant^; + vtAnsiString: + AsAnsiString := AnsiString(VAnsiString); + vtUnicodeString: + AsUnicodeString := UnicodeString(VUnicodeString); vtWideString: AsWideString := WideString(VWideString); vtInt64: @@ -457,6 +494,11 @@ begin Result := nil; end; +function TField.GetAsCurrency: Currency; +begin + Result := GetAsFloat; +end; + function TField.GetAsDateTime: TDateTime; begin @@ -469,6 +511,11 @@ begin raise AccessError(SDateTime); end; +function TField.GetAsLargeInt: Largeint; +begin + Raise AccessError(SLargeInt); +end; + function TField.GetAsLongint: Longint; begin @@ -489,14 +536,28 @@ end; function TField.GetAsString: string; - begin - Result := GetClassDesc; + Result := GetClassDesc +end; + +function TField.GetAsAnsiString: AnsiString; +begin + Result := GetAsString; +end; + +function TField.GetAsUnicodeString: UnicodeString; +begin + Result := GetAsString; +end; + +function TField.GetAsUTF8String: UTF8String; +begin + Result := GetAsString; end; function TField.GetAsWideString: WideString; begin - Result := GetAsString; + Result := GetAsUnicodeString; end; function TField.GetOldValue: variant; @@ -629,7 +690,7 @@ begin Result:=(DisplayLabel<>FieldName); end; -Function TField.IsDisplayWidthStored : Boolean; +function TField.IsDisplayWidthStored: Boolean; begin Result:=(FDisplayWidth<>0); @@ -664,16 +725,6 @@ begin Result := FieldKind = fkLookup; end; -function TField.GetAsLargeInt: LargeInt; -begin - Raise AccessError(SLargeInt); -end; - -function TField.GetAsCurrency: Currency; -begin - Result := GetAsFloat; -end; - procedure TField.SetAlignment(const AValue: TAlignMent); begin if FAlignment <> AValue then @@ -844,11 +895,26 @@ begin Raise AccessError(SString); end; -procedure TField.SetAsWideString(const AValue: WideString); +procedure TField.SetAsAnsiString(const AValue: AnsiString); begin SetAsString(AValue); end; +procedure TField.SetAsUnicodeString(const AValue: UnicodeString); +begin + SetAsString(AValue); +end; + +procedure TField.SetAsUTF8String(const AValue: UTF8String); +begin + SetAsString(AValue); +end; + +procedure TField.SetAsWideString(const AValue: WideString); +begin + SetAsUnicodeString(AValue); +end; + procedure TField.SetData(Buffer: Pointer); @@ -914,7 +980,7 @@ end; procedure TField.SetText(const AValue: string); begin - AsString:=AValue; + SetAsString(AValue); end; procedure TField.SetVarValue(const AValue: Variant); @@ -1040,9 +1106,10 @@ constructor TStringField.Create(AOwner: TComponent); begin Inherited Create(AOwner); SetDataType(ftString); + FCodePage := CP_ACP; FFixedChar := False; FTransliterate := False; - FSize:=20; + FSize := 20; end; procedure TStringField.SetFieldType(AValue: TFieldType); @@ -1058,7 +1125,7 @@ begin // a query like: 'select '' as fieldname from table' which // results in a string with size 0. If (AValue<0) Then - databaseErrorFmt(SInvalidFieldSize,[AValue]) + DatabaseErrorFmt(SInvalidFieldSize,[AValue]) end; function TStringField.GetAsBoolean: Boolean; @@ -1094,16 +1161,37 @@ begin Result:=StrToInt64(GetAsString); end; -function TStringField.GetAsString: string; - +function TStringField.GetAsString: String; begin - If Not GetValue(Result) then +{$IFDEF UNICODE} + Result := GetAsAnsiString; +{$ELSE} + if GetValue(RawByteString(Result)) then + SetCodePage(RawByteString(Result), CP_ACP, True) + else + Result:=''; +{$ENDIF} +end; + +function TStringField.GetAsAnsiString: AnsiString; +begin + if GetValue(RawByteString(Result)) then + SetCodePage(RawByteString(Result), CP_ACP, True) + else Result:=''; end; -function TStringField.GetAsVariant: Variant; +function TStringField.GetAsUTF8String: UTF8String; +begin + if GetValue(RawByteString(Result)) then + SetCodePage(RawByteString(Result), CP_UTF8, True) + else + Result:=''; +end; -var s : string; +function TStringField.GetAsVariant: variant; + +var s : rawbytestring; begin If GetValue(s) then @@ -1116,7 +1204,10 @@ end; function TStringField.GetDataSize: Integer; begin - Result:=Size+1; + case FCodePage of + CP_UTF8: Result := 4*Size+1; + else Result := Size+1; + end; end; function TStringField.GetDefaultWidth: Longint; @@ -1125,22 +1216,22 @@ begin result:=Size; end; -Procedure TStringField.GetText(var AText: string; ADisplayText: Boolean); +procedure TStringField.GetText(var AText: string; ADisplayText: Boolean); begin AText:=GetAsString; end; -function TStringField.GetValue(var AValue: string): Boolean; +function TStringField.GetValue(out AValue: RawByteString): Boolean; var Buf, TBuf : TStringFieldBuffer; - DynBuf, TDynBuf : Array of char; + DynBuf, TDynBuf : Array of AnsiChar; begin if DataSize <= dsMaxStringSize then begin Result:=GetData(@Buf); - Buf[Size]:=#0; //limit string to Size + Buf[DataSize-1]:=#0; //limit string to Size If Result then begin if Transliterate then @@ -1156,19 +1247,20 @@ begin begin SetLength(DynBuf,DataSize); Result:=GetData(@DynBuf[0]); - DynBuf[Size]:=#0; //limit string to Size + DynBuf[DataSize-1]:=#0; //limit string to Size If Result then begin if Transliterate then begin SetLength(TDynBuf,DataSize); DataSet.Translate(@DynBuf[0],@TDynBuf[0],False); - AValue:=pchar(TDynBuf); + AValue:=PAnsiChar(TDynBuf); end else - AValue:=pchar(DynBuf); + AValue:=PAnsiChar(DynBuf); end end; + SetCodePage(AValue, FCodePage, False); end; procedure TStringField.SetAsBoolean(AValue: Boolean); @@ -1204,38 +1296,60 @@ begin SetAsString(IntToStr(AValue)); end; -procedure TStringField.SetAsString(const AValue: string); - +procedure TStringField.SetValue(AValue: RawByteString); var Buf : TStringFieldBuffer; - DynBuf : array of char; - + DynBuf : array of AnsiChar; begin - if Length(AValue)=0 then + if AValue='' then begin Buf := #0; SetData(@Buf); end - else if DataSize <= dsMaxStringSize then - begin - if FTransliterate then - DataSet.Translate(@AValue[1],Buf,True) - else - // The data is copied into the buffer, since some TDataset descendents copy - // the whole buffer-length in SetData. (See bug 8477) - StrPLCopy(PChar(Buf), AValue, Size); - // If length(AValue) > Size the buffer isn't terminated properly ? - Buf[Size] := #0; - SetData(@Buf); - end else begin - SetLength(DynBuf, DataSize); - if FTransliterate then - DataSet.Translate(@AValue[1],@DynBuf[0],True) + if StringCodePage(AValue) <> FCodePage then + SetCodePage(AValue, FCodePage, True); + if DataSize <= dsMaxStringSize then + begin + if FTransliterate then + DataSet.Translate(@AValue[1],Buf,True) + else + // The data is copied into the buffer, since some TDataset descendents copy + // the whole buffer-length in SetData. (See bug 8477) + StrPLCopy(PAnsiChar(Buf), AValue, DataSize-1); + // If length(AValue) > Size the buffer isn't terminated properly ? + Buf[DataSize-1] := #0; + SetData(@Buf); + end else - StrPLCopy(PChar(DynBuf), AValue, Size); - SetData(@DynBuf[0]); - end + begin + SetLength(DynBuf, DataSize); + if FTransliterate then + DataSet.Translate(@AValue[1],@DynBuf[0],True) + else + StrPLCopy(PAnsiChar(DynBuf), AValue, DataSize-1); + SetData(@DynBuf[0]); + end; + end; +end; + +procedure TStringField.SetAsString(const AValue: String); +begin +{$IFDEF UNICODE} + SetAsAnsiString(AValue); +{$ELSE} + SetValue(AValue); +{$ENDIF} +end; + +procedure TStringField.SetAsAnsiString(const AValue: AnsiString); +begin + SetValue(AValue); +end; + +procedure TStringField.SetAsUTF8String(const AValue: UTF8String); +begin + SetValue(AValue); end; procedure TStringField.SetVarValue(const AValue: Variant); @@ -1243,6 +1357,7 @@ begin SetAsString(AValue); end; + { --------------------------------------------------------------------- TWideStringField ---------------------------------------------------------------------} @@ -1253,13 +1368,14 @@ begin // a query like: 'select '' as fieldname from table' which // results in a string with size 0. If (AValue<0) Then - databaseErrorFmt(SInvalidFieldSize,[AValue]); + DatabaseErrorFmt(SInvalidFieldSize,[AValue]); end; constructor TWideStringField.Create(AOwner: TComponent); begin inherited Create(AOwner); SetDataType(ftWideString); + FCodePage := CP_UTF16; end; procedure TWideStringField.SetFieldType(AValue: TFieldType); @@ -1268,11 +1384,11 @@ begin SetDataType(AValue); end; -function TWideStringField.GetValue(var AValue: WideString): Boolean; +function TWideStringField.GetValue(out AValue: UnicodeString): Boolean; var - FixBuffer : array[0..dsMaxStringSize div 2] of WideChar; - DynBuffer : array of WideChar; - Buffer : PWideChar; + FixBuffer : array[0..dsMaxStringSize div 2] of UnicodeChar; + DynBuffer : array of UnicodeChar; + Buffer : PUnicodeChar; begin if DataSize <= dsMaxStringSize then begin Result := GetData(@FixBuffer, False); @@ -1280,7 +1396,7 @@ begin AValue := FixBuffer; end else begin SetLength(DynBuffer, Succ(Size)); - Buffer := PWideChar(DynBuffer); + Buffer := PUnicodeChar(DynBuffer); Result := GetData(Buffer, False); Buffer[Size]:=#0; //limit string to Size if Result then @@ -1290,20 +1406,43 @@ end; function TWideStringField.GetAsString: string; begin - Result := GetAsWideString; +{$IFDEF UNICODE} + if not GetValue(Result) then + Result := ''; +{$ELSE} + Result := GetAsUnicodeString; +{$ENDIF} end; procedure TWideStringField.SetAsString(const AValue: string); begin - SetAsWideString(AValue); + SetAsUnicodeString(AValue); +end; + +function TWideStringField.GetAsUnicodeString: UnicodeString; +begin + if not GetValue(Result) then + Result := ''; +end; + +procedure TWideStringField.SetAsUnicodeString(const AValue: UnicodeString); +const + NullUnicodeChar : UnicodeChar = #0; +var + Buffer : PUnicodeChar; +begin + if Length(AValue)>0 then + Buffer := PUnicodeChar(@AValue[1]) + else + Buffer := @NullUnicodeChar; + SetData(Buffer, False); end; function TWideStringField.GetAsVariant: Variant; -var - ws: WideString; +var us: UnicodeString; begin - if GetValue(ws) then - Result := ws + if GetValue(us) then + Result := us else Result := Null; end; @@ -1314,28 +1453,32 @@ begin end; function TWideStringField.GetAsWideString: WideString; +var us: UnicodeString; begin - if not GetValue(Result) then + if GetValue(us) then + Result := us + else 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); + SetAsUnicodeString(AValue); +end; + +function TWideStringField.GetAsUTF8String: UTF8String; +begin + Result := GetAsUnicodeString; +end; + +procedure TWideStringField.SetAsUTF8String(const AValue: UTF8String); +begin + SetAsUnicodeString(AValue); end; function TWideStringField.GetDataSize: Integer; begin - Result := - (Size + 1) * 2; + Result := (Size + 1) * 2; end; @@ -1852,7 +1995,7 @@ begin Result:=SizeOf(Double); end; -procedure TFloatField.GetText(var TheText: string; ADisplayText: Boolean); +procedure TFloatField.GetText(var AText: string; ADisplayText: Boolean); Var fmt : string; @@ -1861,7 +2004,7 @@ Var ff: TFloatFormat; begin - TheText:=''; + AText:=''; If Not GetData(@E) then exit; If ADisplayText or (Length(FEditFormat) = 0) Then Fmt:=FDisplayFormat @@ -1882,9 +2025,9 @@ begin If fmt<>'' then - TheText:=FormatFloat(fmt,E) + AText:=FormatFloat(fmt,E) else - TheText:=FloatToStrF(E,ff,FPrecision,Digits); + AText:=FloatToStrF(E,ff,FPrecision,Digits); end; procedure TFloatField.SetAsBCD(const AValue: TBCD); @@ -2132,14 +2275,14 @@ begin end; -procedure TDateTimeField.GetText(var TheText: string; ADisplayText: Boolean); +procedure TDateTimeField.GetText(var AText: string; ADisplayText: Boolean); var R : TDateTime; F : String; begin If Not GetData(@R,False) then - TheText:='' + AText:='' else begin If (ADisplayText) and (Length(FDisplayFormat)<>0) then @@ -2151,7 +2294,7 @@ begin else F:='c' end; - TheText:=FormatDateTime(F,R); + AText:=FormatDateTime(F,R); end; end; @@ -2273,13 +2416,6 @@ begin end; -procedure TBinaryField.GetText(var TheText: string; ADisplayText: Boolean); - -begin - TheText:=GetAsString; -end; - - function TBinaryField.GetValue(var AValue: TBytes): Boolean; var B: TBytes; begin @@ -2340,12 +2476,6 @@ begin end; -procedure TBinaryField.SetText(const AValue: string); - -begin - SetAsString(AValue); -end; - procedure TBinaryField.SetVarValue(const AValue: Variant); var P: Pointer; B: TBytes; @@ -2494,27 +2624,27 @@ begin else Result := 10; end; -procedure TBCDField.GetText(var TheText: string; ADisplayText: Boolean); +procedure TBCDField.GetText(var AText: string; ADisplayText: Boolean); var c : system.currency; fmt: String; begin if GetData(@C) then begin - if aDisplayText or (FEditFormat='') then + if ADisplayText or (FEditFormat='') then fmt := FDisplayFormat else fmt := FEditFormat; if fmt<>'' then - TheText := FormatFloat(fmt,C) + AText := FormatFloat(fmt,C) else if fCurrency then begin - if aDisplayText then - TheText := FloatToStrF(C, ffCurrency, FPrecision, 2{digits?}) + if ADisplayText then + AText := FloatToStrF(C, ffCurrency, FPrecision, 2{digits?}) else - TheText := FloatToStrF(C, ffFixed, FPrecision, 2{digits?}); + AText := FloatToStrF(C, ffFixed, FPrecision, 2{digits?}); end else - TheText := FloatToStrF(C, ffGeneral, FPrecision, 0{digits?}); + AText := FloatToStrF(C, ffGeneral, FPrecision, 0{digits?}); end else - TheText := ''; + AText := ''; end; procedure TBCDField.SetAsBCD(const AValue: TBCD); @@ -2672,27 +2802,27 @@ begin Result:=''; end; -procedure TFMTBCDField.GetText(var TheText: string; ADisplayText: Boolean); +procedure TFMTBCDField.GetText(var AText: string; ADisplayText: Boolean); var bcd: TBCD; fmt: String; begin if GetData(@bcd) then begin - if aDisplayText or (FEditFormat='') then + if ADisplayText or (FEditFormat='') then fmt := FDisplayFormat else fmt := FEditFormat; if fmt<>'' then - TheText := FormatBCD(fmt,bcd) + AText := FormatBCD(fmt,bcd) else if fCurrency then begin - if aDisplayText then - TheText := BcdToStrF(bcd, ffCurrency, FPrecision, 2) + if ADisplayText then + AText := BcdToStrF(bcd, ffCurrency, FPrecision, 2) else - TheText := BcdToStrF(bcd, ffFixed, FPrecision, 2); + AText := BcdToStrF(bcd, ffFixed, FPrecision, 2); end else - TheText := BcdToStrF(bcd, ffGeneral, FPrecision, FSize); + AText := BcdToStrF(bcd, ffGeneral, FPrecision, FSize); end else - TheText := ''; + AText := ''; end; function TFMTBCDField.GetMaxValue: string; @@ -2769,6 +2899,14 @@ end; { TBlobField } +constructor TBlobField.Create(AOwner: TComponent); + +begin + Inherited Create(AOwner); + SetDataType(ftBlob); +end; + + function TBlobField.GetBlobStream(Mode: TBlobStreamMode): TStream; begin @@ -2777,7 +2915,7 @@ end; function TBlobField.GetBlobType: TBlobType; begin - result:= TBlobType(DataType); + Result:= TBlobType(DataType); end; procedure TBlobField.SetBlobType(AValue: TBlobType); @@ -2786,7 +2924,6 @@ begin end; procedure TBlobField.FreeBuffers; - begin end; @@ -2810,11 +2947,19 @@ begin end; function TBlobField.GetAsString: string; +begin +{$IFDEF UNICODE} + Result := GetAsUnicodeString; +{$ELSE} + Result := GetAsAnsiString; +{$ENDIF} +end; + +function TBlobField.GetAsAnsiString: AnsiString; var Stream : TStream; Len : Integer; - S : String; - + S : AnsiString; begin Stream := GetBlobStream(bmRead); if Stream <> nil then @@ -2836,13 +2981,13 @@ begin else Result := ''; finally - Free; + Free; end else Result := ''; end; -function TBlobField.GetAsWideString: WideString; +function TBlobField.GetAsUnicodeString: UnicodeString; var Stream : TStream; Len : Integer; @@ -2863,15 +3008,11 @@ begin end; function TBlobField.GetAsVariant: Variant; -var s : string; begin if not GetIsNull then - begin - s := GetAsString; - result := s; - end + Result := GetAsString else - result := Null; + Result := Null; end; @@ -2906,13 +3047,12 @@ begin end; end; - -procedure TBlobField.GetText(var TheText: string; ADisplayText: Boolean); - +procedure TBlobField.GetText(var AText: string; ADisplayText: Boolean); begin - TheText:=inherited GetAsString; + AText := inherited GetAsString; end; + procedure TBlobField.SetAsBytes(const AValue: TBytes); var Len : Integer; @@ -2929,10 +3069,18 @@ end; procedure TBlobField.SetAsString(const AValue: string); +begin +{$IFDEF UNICODE} + SetAsUnicodeString(AValue); +{$ELSE} + SetAsAnsiString(AValue); +{$ENDIF} +end; + +procedure TBlobField.SetAsAnsiString(const AValue: AnsiString); var Len : Integer; - S : String; - + S : AnsiString; begin with GetBlobStream(bmWrite) do try @@ -2945,7 +3093,7 @@ begin begin SetLength(S,Len); Len:=DataSet.Translate(@AValue[1],@S[1],True); - end; + end; WriteBuffer(S[1], Len); end; finally @@ -2953,13 +3101,13 @@ begin end; end; -procedure TBlobField.SetAsWideString(const AValue: WideString); +procedure TBlobField.SetAsUnicodeString(const AValue: UnicodeString); var Len : Integer; begin with GetBlobStream(bmWrite) do try - Len := Length(AValue) * 2; + Len := Length(AValue) * SizeOf(UnicodeChar); if Len > 0 then WriteBuffer(AValue[1], Len); finally @@ -2968,26 +3116,12 @@ begin end; -procedure TBlobField.SetText(const AValue: string); - -begin - SetAsString(AValue); -end; - procedure TBlobField.SetVarValue(const AValue: Variant); begin SetAsString(AValue); end; -constructor TBlobField.Create(AOwner: TComponent); - -begin - Inherited Create(AOWner); - SetDataType(ftBlob); -end; - - procedure TBlobField.Clear; begin @@ -3059,20 +3193,46 @@ end; { TMemoField } constructor TMemoField.Create(AOwner: TComponent); - begin - Inherited Create(AOwner); + inherited Create(AOwner); SetDataType(ftMemo); end; -function TMemoField.GetAsWideString: WideString; +function TMemoField.GetAsAnsiString: AnsiString; begin - Result := GetAsString; + Result := inherited GetAsAnsiString; + SetCodePage(RawByteString(Result), FCodePage, False); + SetCodePage(RawByteString(Result), CP_ACP, True); end; -procedure TMemoField.SetAsWideString(const AValue: WideString); +procedure TMemoField.SetAsAnsiString(const AValue: AnsiString); +var s: RawByteString; begin - SetAsString(AValue); + s := AValue; + SetCodePage(s, FCodePage, True); + inherited SetAsAnsiString(s); +end; + +function TMemoField.GetAsUnicodeString: UnicodeString; +begin + Result:=GetAsAnsiString; +end; + +procedure TMemoField.SetAsUnicodeString(const AValue: UnicodeString); +begin + SetAsAnsiString(AValue); +end; + +function TMemoField.GetAsUTF8String: UTF8String; +begin + Result := inherited GetAsAnsiString; + SetCodePage(RawByteString(Result), FCodePage, False); + SetCodePage(RawByteString(Result), CP_UTF8, True); +end; + +procedure TMemoField.SetAsUTF8String(const AValue: UTF8String); +begin + SetAsAnsiString(AValue); end; { TWideMemoField } @@ -3085,28 +3245,45 @@ end; function TWideMemoField.GetAsString: string; begin - Result := GetAsWideString; + Result := GetAsUnicodeString; end; procedure TWideMemoField.SetAsString(const AValue: string); begin - SetAsWideString(AValue); + SetAsUnicodeString(AValue); +end; + +function TWideMemoField.GetAsAnsiString: AnsiString; +begin + Result := GetAsUnicodeString; +end; + +procedure TWideMemoField.SetAsAnsiString(const AValue: AnsiString); +begin + SetAsUnicodeString(AValue); +end; + +function TWideMemoField.GetAsUTF8String: UTF8String; +begin + Result := GetAsUnicodeString; +end; + +procedure TWideMemoField.SetAsUTF8String(const AValue: UTF8String); +begin + SetAsUnicodeString(AValue); end; function TWideMemoField.GetAsVariant: Variant; -var s : string; begin if not GetIsNull then - begin - s := GetAsWideString; - result := s; - end - else result := Null; + Result := GetAsUnicodeString + else + Result := Null; end; procedure TWideMemoField.SetVarValue(const AValue: Variant); begin - SetAsWideString(AValue); + SetAsUnicodeString(AValue); end; { TGraphicField }