fcl

git-svn-id: trunk@24267 -

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

@@ -374,7 +374,7 @@ type
 
     function  IsDeleted: Boolean;
     procedure Undelete;
-
+    // Call this after setting up fielddefs in order to store the definitions into a table
     procedure CreateTable;
     procedure CreateTableEx(ADbfFieldDefs: TDbfFieldDefs);
     procedure CopyFrom(DataSet: TDataSet; FileName: string; DateTimeAsString: Boolean; Level: Integer);
@@ -1048,18 +1048,17 @@ end;
 
 procedure TDbf.GetFieldDefsFromDbfFieldDefs;
 var
-  I, N: Integer;
+  I: Integer;
   TempFieldDef: TDbfFieldDef;
   TempMdxFile: TIndexFile;
-  BaseName, lIndexName: string;
+  lIndexName: string;
-begin
+  lFieldDefCount: integer; //Counter for destination fielddefs
-  FieldDefs.Clear;
 
-  // get all fields
+  procedure FixDuplicateNames;
-  for I := 0 to FDbfFile.FieldDefs.Count - 1 do
+  var
+    BaseName: string;
+    N: Integer;
   begin
-    TempFieldDef := FDbfFile.FieldDefs.Items[I];
-    // handle duplicate field names
     N := 1;
     BaseName := TempFieldDef.FieldName;
     while FieldDefs.IndexOf(TempFieldDef.FieldName)>=0 do
@@ -1067,6 +1066,18 @@ begin
       Inc(N);
       TempFieldDef.FieldName:=BaseName+IntToStr(N);
     end;
+  end;
+
+begin
+  FieldDefs.Clear;
+
+  // get all fields
+  lFieldDefCount:=-1; //will be fixed by first addition
+  for I := 0 to FDbfFile.FieldDefs.Count - 1 do
+  begin
+    TempFieldDef := FDbfFile.FieldDefs.Items[I];
+    // handle duplicate field names:
+    FixDuplicateNames;
     // add field, passing dbase native size if relevant
     // TDbfFieldDef.Size indicates the number of bytes in the physical dbase file
     // TFieldDef.Size is only meant to store size indicator for variable length fields
@@ -1079,21 +1090,31 @@ begin
     else
       FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, 0, false);
     end;
+    lFieldDefCount:=lFieldDefCount+1;
 
-    FieldDefs[I].Precision := TempFieldDef.Precision;
+    FieldDefs[lFieldDefCount].Precision := TempFieldDef.Precision;
 
 {$ifdef SUPPORT_FIELDDEF_ATTRIBUTES}
     // AutoInc fields are readonly
     if TempFieldDef.FieldType = ftAutoInc then
-      FieldDefs[I].Attributes := [Db.faReadOnly];
+      FieldDefs[lFieldDefCount].Attributes := [Db.faReadOnly];
 
     // if table has dbase lock field, then hide it
     if TempFieldDef.IsLockField then
-      FieldDefs[I].Attributes := [Db.faHiddenCol];
+      FieldDefs[lFieldDefCount].Attributes := [Db.faHiddenCol];
 
     // Hide system/hidden fields (e.g. VFP's _NULLFLAGS)
     if TempFieldDef.IsSystemField then
-      FieldDefs[I].Attributes := [Db.faHiddenCol];
+      FieldDefs[lFieldDefCount].Attributes := [Db.faHiddenCol];
+{$else}
+    // Poor man's way of hiding fields that shouldn't be shown/modified:
+    // Note: Visual Foxpro seems to allow adding another _NULLFLAGS field
+    // todo: test this with lockfield, then add this (TempFieldDef.IsLockField)
+    if (TempFieldDef.IsSystemField) then
+    begin
+      FieldDefs.Delete(lFieldDefCount);
+      lFieldDefCount:=lFieldDefCount-1;
+    end;
 {$endif}
   end;
 

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

@@ -53,7 +53,7 @@ type
   protected
     function  GetDisplayName: string; override;
     procedure AssignTo(Dest: TPersistent); override;
-
+    // File is compatible with this database product
     property DbfVersion: TXBaseVersion read GetDbfVersion;
   public
     constructor Create(ACollection: TCollection); override;
@@ -97,7 +97,7 @@ type
     // Note: VarLengthPosition property is 0 based
     // http://msdn.microsoft.com/en-us/library/st4a0s68%28v=VS.80%29.aspx
     property VarLengthPosition: integer read FVarLengthPosition write FVarLengthPosition;
-    // Native dbf field type
+    // Native dbf field type (C character etc)
     property NativeFieldType: TDbfFieldType read FNativeFieldType write SetNativeFieldType;
     // Size in physical dbase file.
     // Note: this often differs from the VCL field sizes

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

@@ -521,7 +521,7 @@ begin
 end;
 
 const
-  // range of Dbase / FoxPro locales; these are INCLUSIVE
+  // range of Dbase locales; these are INCLUSIVE (the rest are FoxPro?)
   dBase_RegionCount = 4;
   dBase_Regions: array[0..dBase_RegionCount*2-1] of Byte =
    ($00, $00,
@@ -530,31 +530,34 @@ const
     $80, $90);
 
 function FindLangId(CodePage, Info2: Cardinal; Info2Table: PCardinal; IsFoxPro: Boolean): Byte;
+// Info2: desired locale
+// Info2Table: pointer to lookup array: language ID=>locale cardinal
 var
-  I, Region, FoxRes, DbfRes: Integer;
+  LangID, Region, FoxRes, DbfRes: Integer;
 begin
   Region := 0;
   DbfRes := 0;
   FoxRes := 0;
-  // scan
+  // scan for a language ID matching the given codepage
-  //todo: verify this for visual foxpro; it doesn't seem to work.
+  for LangID := 0 to $FF do
-  for I := 0 to $FF do
   begin
     // check if need to advance to next region
     if Region + 2 < dBase_RegionCount then
-      if I >= dBase_Regions[Region + 2] then
+      if LangID >= dBase_Regions[Region + 2] then
         Inc(Region, 2);
     // it seems delphi does not properly understand pointers?
     // what a mess :-(
-    if ((LangId_To_CodePage[I] = CodePage) or (CodePage = 0)) and (PCardinal(PChar(Info2Table)+(I*4))^ = Info2) then
+    //todo: verify this for visual foxpro; we never seem to get a result
-      if I <= dBase_Regions[Region+1] then
+    if ((LangId_To_CodePage[LangID] = CodePage) or (CodePage = 0)) and
-        DbfRes := Byte(I)
+      (PCardinal(PChar(Info2Table)+(LangID*4))^ = Info2) then
+      if LangID <= dBase_Regions[Region+1] then
+        DbfRes := Byte(LangID)
       else
-        FoxRes := Byte(I);
+        FoxRes := Byte(LangID);
   end;
   // if we can find langid in other set, use it
   if (DbfRes <> 0) and (not IsFoxPro or (FoxRes = 0)) then
-    Result := DbfRes
+    Result := DbfRes //if not using foxpro
   else  {(DbfRes = 0) or (IsFoxPro and (FoxRes <> 0)}
   if (FoxRes <> 0) {and (IsFoxPro or (DbfRes = 0)} then
     Result := FoxRes
@@ -603,7 +606,7 @@ end;
 
 function ConstructLangId(CodePage: Integer; Locale: LCID; IsFoxPro: Boolean): Byte;
 begin
-  // locale: lower 16bits only
+  // locale: lower 16bits only, with default sorting
   Locale := (Locale and $FFFF) or (SORT_DEFAULT shl 16);
   Result := FindLangId(CodePage, Locale, @LangId_To_Locale[0], IsFoxPro);
   // not found? try any codepage