paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 12:26:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Introduce codepage, bug ID #0016587

Browse Source 
git-svn-id: trunk@43105 -
This commit is contained in:
michael 2019-10-02 07:26:54 +00:00
parent b978d7b6d5
commit ab12408a44
1 changed files with 42 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
packages/fcl-db/src/sdf/sdfdata.pp
View File

@ -158,6 +158,7 @@ type
//----------------------------------------------------------------------------- //-----------------------------------------------------------------------------
TFixedFormatDataSet = class(TDataSet) TFixedFormatDataSet = class(TDataSet)
private private
FCodePage: String;
FSchema :TStringList; FSchema :TStringList;
FFileName :TFileName; FFileName :TFileName;
FFilterBuffer :TRecordBuffer; FFilterBuffer :TRecordBuffer;
@ -165,6 +166,8 @@ type
FReadOnly :Boolean; FReadOnly :Boolean;
FLoadFromStream :Boolean; FLoadFromStream :Boolean;
FTrimSpace :Boolean; FTrimSpace :Boolean;
FEncoding : TEncoding;
procedure SetCodePage(AValue: String);
procedure SetSchema(const Value: TStringList); procedure SetSchema(const Value: TStringList);
procedure SetFileName(Value : TFileName); procedure SetFileName(Value : TFileName);
procedure SetFileMustExist(Value : Boolean); procedure SetFileMustExist(Value : Boolean);
@ -236,6 +239,7 @@ type
property FileName : TFileName read FFileName write SetFileName; property FileName : TFileName read FFileName write SetFileName;
property Schema: TStringList read FSchema write SetSchema; property Schema: TStringList read FSchema write SetSchema;
property TrimSpace: Boolean read FTrimSpace write SetTrimSpace default True; property TrimSpace: Boolean read FTrimSpace write SetTrimSpace default True;
Property CodePage : String Read FCodePage Write SetCodePage;
property FieldDefs; property FieldDefs;
property Active; property Active;
property AutoCalcFields; property AutoCalcFields;
@ -301,6 +305,10 @@ implementation
//{$R *.Res} //{$R *.Res}
Resourcestring
SErrUnknownCodePage = 'Unknown code page: %s';
//----------------------------------------------------------------------------- //-----------------------------------------------------------------------------
// TFixedFormatDataSet // TFixedFormatDataSet
//----------------------------------------------------------------------------- //-----------------------------------------------------------------------------
@ -319,8 +327,9 @@ end;
destructor TFixedFormatDataSet.Destroy; destructor TFixedFormatDataSet.Destroy;
begin begin
inherited Destroy; inherited Destroy;
FData.Free; FreeAndNil(FEncoding);
FSchema.Free; FreeAndNil(FData);
FreeAndNil(FSchema);
end; end;
procedure TFixedFormatDataSet.SetSchema(const Value: TStringList); procedure TFixedFormatDataSet.SetSchema(const Value: TStringList);
@ -329,6 +338,22 @@ begin
FSchema.Assign(Value); FSchema.Assign(Value);
end; end;
procedure TFixedFormatDataSet.SetCodePage(AValue: String);
Var
F : TSystemCodePage;
begin
if FCodePage=AValue then Exit;
CheckInactive;
F:=CodePageNameToCodePage(aValue);
if (F=$FFFF) then
DatabaseErrorFmt(SErrUnknownCodePage,[aValue]);
FCodePage:=AValue;
FreeAndNil(FEncoding);
FEncoding:=TMBCSEncoding.Create(F);
end;
procedure TFixedFormatDataSet.SetFileMustExist(Value : Boolean); procedure TFixedFormatDataSet.SetFileMustExist(Value : Boolean);
begin begin
CheckInactive; CheckInactive;
@ -357,6 +382,8 @@ procedure TFixedFormatDataSet.InternalInitFieldDefs;
var var
i, Len, MaxLen :Integer; i, Len, MaxLen :Integer;
LstFields :TStrings; LstFields :TStrings;
FEnc : TSystemCodePage;
begin begin
if not Assigned(FData) then Exit; if not Assigned(FData) then Exit;
@ -379,7 +406,11 @@ begin
for i := 0 to LstFields.Count -1 do // Add fields for i := 0 to LstFields.Count -1 do // Add fields
begin begin
Len := StrToIntDef(LstFields.Values[LstFields.Names[i]], MaxLen); Len := StrToIntDef(LstFields.Values[LstFields.Names[i]], MaxLen);
FieldDefs.Add(Trim(LstFields.Names[i]), ftString, Len, False); if Assigned(FEncoding) then
Fenc:=FEncoding.CodePage
else
FEnc:=DefaultSystemCodePage;
FieldDefs.Add(Trim(LstFields.Names[i]), ftString, Len, 0, False,False,FieldDefs.Count+1,FEnc);
Inc(Len); Inc(Len);
{$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT} {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
Len := Align(Len, SizeOf(PtrInt)); Len := Align(Len, SizeOf(PtrInt));
@ -460,7 +491,10 @@ begin
FLoadFromStream := True; FLoadFromStream := True;
if not Assigned(FData) then if not Assigned(FData) then
raise Exception.Create('Data buffer unassigned'); raise Exception.Create('Data buffer unassigned');
FData.LoadFromStream(Stream); if Assigned(FEncoding) then
FData.LoadFromStream(Stream,FEncoding)
else
FData.LoadFromStream(Stream);
Active := True; Active := True;
end end
else else
@ -471,7 +505,10 @@ end;
procedure TFixedFormatDataSet.SaveToStream(Stream: TStream); procedure TFixedFormatDataSet.SaveToStream(Stream: TStream);
begin begin
if assigned(stream) then if assigned(stream) then
FData.SaveToStream(Stream) if assigned(Fencoding) then
FData.SaveToStream(Stream,FEncoding)
else
FData.SaveToStream(Stream)
else else
raise exception.Create('Invalid Stream Assigned (Save To Stream'); raise exception.Create('Invalid Stream Assigned (Save To Stream');
end; end;