fcl-db/dbase: codepage refinement and preliminary testcase

git-svn-id: trunk@24286 -

packages/fcl-db/src/dbase/dbf_dbffile.pas

@@ -632,7 +632,8 @@ begin
     if FDbfVersion in [xFoxPro, xVisualFoxPro] then
     begin
       // Don't use DbfGlobals default language ID as it is dbase-based
-      FFileLangId := ConstructLangId(LangId_To_CodePage[FFileLangId],GetUserDefaultLCID, true);
+      if FFileLangId = 0 then
+        FFileLangId := ConstructLangId(LangId_To_CodePage[FFileLangId],GetUserDefaultLCID, true);
     end
     else
     begin

packages/fcl-db/tests/testspecifictdbf.pas

@@ -55,6 +55,8 @@ type
     procedure TestMemo;
     // Tests string field with 254 characters (max for DBase IV)
     procedure TestLargeString;
+    // Tests codepage in created dbf
+    procedure TestCodePage;
   end;
 
 
@@ -408,6 +410,40 @@ begin
   ds.free;
 end;
 
+procedure TTestSpecificTDBF.TestCodePage;
+const
+  // Chose non-default (i.e. 437,850,1252) cps
+  DOSCodePage=865; //Nordic ms dos
+  DOSLanguageID=$66; //... corresponding language ID (according to VFP docs; other sources say $65)
+  WindowsCodePage=1251; //Russian windows
+  WindowsLanguageID=$C9; //.... corresponding language ID
+var
+  RequestLanguageID: integer; //dbf language ID marker (byte 29)
+  CorrespondingCodePage: integer;
+  ds : TDBF;
+begin
+  if ((DS as TDBFAutoClean).UserRequestedTableLevel=25) then
+    ignore('Foxpro (tablelevel 25) may write data out in dBase IV (tablelevel 4) format.');
+  ds := TDBFAutoClean.Create(nil);
+  DS.FieldDefs.Add('ID',ftInteger);
+  if ((DS as TDBFAutoClean).UserRequestedTableLevel in [7,30]) then
+  begin
+    RequestLanguageID:=WindowsLanguageID;
+    CorrespondingCodePage:=WindowsCodePage //Visual FoxPro, DBase7
+  end
+  else
+  begin
+    RequestLanguageID:=DOSLanguageID;
+    CorrespondingCodePage:=DOSCodePage;
+  end;
+  (DS as TDBFAutoClean).LanguageID:=RequestLanguageID;
+  DS.CreateTable;
+  DS.Open;
+  CheckEquals(CorrespondingCodePage,DS.CodePage,'DBF codepage should match requested codeapage.');
+  DS.Close;
+  ds.free;
+end;
+
 
 
 initialization