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

fcl-db/dbase: tentative fix for Visual Foxpro 'B' double

Browse Source 
git-svn-id: trunk@24320 -
This commit is contained in:
reiniero 2013-04-25 14:55:39 +00:00
parent 65a4585012
commit f05381183a
2 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1741,7 +1741,7 @@ begin
SaveDateToDst;
end;
end;
'Y':
'Y': // currency
begin
{$ifdef SUPPORT_INT64}
Result := true;
@ -1757,10 +1757,14 @@ begin
begin
if (FDbfVersion in [xFoxPro,xVisualFoxPro]) then
begin
Result := true;
if Dst <> nil then
PInt64(Dst)^ := SwapIntLE(Unaligned(PInt64(Src)^));
end else
{$ifdef SUPPORT_INT64}
Result := Unaligned(PInt64(Src)^) <> 0;
if Result and (Dst <> nil) then
begin
SwapInt64LE(Src, Dst);
PDouble(Dst)^ := PDouble(Dst)^;
end;
{$endif} end else
asciiContents := true;
end;
'M':

4
packages/fcl-db/src/dbase/dbf_lang.pas
View File

@ -569,11 +569,9 @@ const
function FindLangId(CodePage, DesiredLocale: Cardinal; LanguageIDToLocaleTable: PCardinal; IsFoxPro: Boolean): Byte;
// DesiredLocale: pointer to lookup array: language ID=>locale
var
i, LangID, Region, FoxRes, DbfRes: Integer;
i, LangID, Region: Integer;
begin
Region := 0;
DbfRes := 0;
FoxRes := 0;
if IsFoxPro then
begin
// scan for a language ID matching the given codepage;