paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 00:08:12 +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)
private
FCodePage: String;
FSchema :TStringList;
FFileName :TFileName;
FFilterBuffer :TRecordBuffer;
@ -165,6 +166,8 @@ type
FReadOnly :Boolean;
FLoadFromStream :Boolean;
FTrimSpace :Boolean;
FEncoding : TEncoding;
procedure SetCodePage(AValue: String);
procedure SetSchema(const Value: TStringList);
procedure SetFileName(Value : TFileName);
procedure SetFileMustExist(Value : Boolean);
@ -236,6 +239,7 @@ type
property FileName : TFileName read FFileName write SetFileName;
property Schema: TStringList read FSchema write SetSchema;
property TrimSpace: Boolean read FTrimSpace write SetTrimSpace default True;
Property CodePage : String Read FCodePage Write SetCodePage;
property FieldDefs;
property Active;
property AutoCalcFields;
@ -301,6 +305,10 @@ implementation
//{$R *.Res}
Resourcestring
SErrUnknownCodePage = 'Unknown code page: %s';
//-----------------------------------------------------------------------------
// TFixedFormatDataSet
//-----------------------------------------------------------------------------
@ -319,8 +327,9 @@ end;
destructor TFixedFormatDataSet.Destroy;
begin
inherited Destroy;
FData.Free;
FSchema.Free;
FreeAndNil(FEncoding);
FreeAndNil(FData);
FreeAndNil(FSchema);
end;
procedure TFixedFormatDataSet.SetSchema(const Value: TStringList);
@ -329,6 +338,22 @@ begin
FSchema.Assign(Value);
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);
begin
CheckInactive;
@ -357,6 +382,8 @@ procedure TFixedFormatDataSet.InternalInitFieldDefs;
var
i, Len, MaxLen :Integer;
LstFields :TStrings;
FEnc : TSystemCodePage;
begin
if not Assigned(FData) then Exit;
@ -379,7 +406,11 @@ begin
for i := 0 to LstFields.Count -1 do // Add fields
begin
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);
{$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
Len := Align(Len, SizeOf(PtrInt));
@ -460,7 +491,10 @@ begin
FLoadFromStream := True;
if not Assigned(FData) then
raise Exception.Create('Data buffer unassigned');
FData.LoadFromStream(Stream);
if Assigned(FEncoding) then
FData.LoadFromStream(Stream,FEncoding)
else
FData.LoadFromStream(Stream);
Active := True;
end
else
@ -471,7 +505,10 @@ end;
procedure TFixedFormatDataSet.SaveToStream(Stream: TStream);
begin
if assigned(stream) then
FData.SaveToStream(Stream)
if assigned(Fencoding) then
FData.SaveToStream(Stream,FEncoding)
else
FData.SaveToStream(Stream)
else
raise exception.Create('Invalid Stream Assigned (Save To Stream');
end;