paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-20 05:40:51 +01:00
Code Issues Packages Projects Releases Wiki Activity

fcl-db: base:

Browse Source 
- 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 -
This commit is contained in:
lacak 2016-07-12 07:23:32 +00:00
parent 9115dc2521
commit d2c53d48e9
5 changed files with 522 additions and 247 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
packages/fcl-db/src/base/bufdataset.pas
View File

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

46
packages/fcl-db/src/base/dataset.inc
View File

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

92
packages/fcl-db/src/base/db.pas
View File

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

68
packages/fcl-db/src/base/dsparams.inc
View File

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

507
packages/fcl-db/src/base/fields.inc
View File

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