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

fcl-db/dbase: codepage refinement and preliminary testcase

Browse Source 
git-svn-id: trunk@24286 -
This commit is contained in:
reiniero 2013-04-21 14:19:00 +00:00
parent 4f10db2686
commit 767261d7ae
2 changed files with 38 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
packages/fcl-db/src/dbase/dbf_dbffile.pas
View File

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

36
packages/fcl-db/tests/testspecifictdbf.pas
View File

@ -55,6 +55,8 @@ type
procedure TestMemo; procedure TestMemo;
// Tests string field with 254 characters (max for DBase IV) // Tests string field with 254 characters (max for DBase IV)
procedure TestLargeString; procedure TestLargeString;
// Tests codepage in created dbf
procedure TestCodePage;
end; end;
@ -408,6 +410,40 @@ begin
ds.free; ds.free;
end; 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 initialization