Browse Source

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

git-svn-id: trunk@24320 -
reiniero 12 years ago
parent
commit
f05381183a

+ 9 - 5
packages/fcl-db/src/dbase/dbf_dbffile.pas

@@ -1741,7 +1741,7 @@ begin
           SaveDateToDst;
           SaveDateToDst;
         end;
         end;
       end;
       end;
-    'Y':
+    'Y': // currency
       begin
       begin
 {$ifdef SUPPORT_INT64}
 {$ifdef SUPPORT_INT64}
         Result := true;
         Result := true;
@@ -1757,10 +1757,14 @@ begin
       begin
       begin
         if (FDbfVersion in [xFoxPro,xVisualFoxPro]) then
         if (FDbfVersion in [xFoxPro,xVisualFoxPro]) then
         begin
         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;
           asciiContents := true;
       end;
       end;
     'M':
     'M':

+ 1 - 3
packages/fcl-db/src/dbase/dbf_lang.pas

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