Browse Source

* Introduce codepage, bug ID #0016587

git-svn-id: trunk@43105 -
michael 5 years ago
parent
commit
ab12408a44
1 changed files with 42 additions and 5 deletions
  1. 42 5
      packages/fcl-db/src/sdf/sdfdata.pp

+ 42 - 5
packages/fcl-db/src/sdf/sdfdata.pp

@@ -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;