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

* fcl-db/fpdbfexport: fix automatic export field name truncation for DBase files

Browse Source 
git-svn-id: trunk@24490 -
This commit is contained in:
reiniero 2013-05-13 09:51:11 +00:00
parent a65cb866d1
commit ec720322bc
1 changed files with 26 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
packages/fcl-db/src/export/fpdbfexport.pp
View File

@ -42,7 +42,7 @@ Type
function GetSettings: TDBFExportFormatSettings; function GetSettings: TDBFExportFormatSettings;
procedure SetSettings(const AValue: TDBFExportFormatSettings); procedure SetSettings(const AValue: TDBFExportFormatSettings);
Protected Protected
Procedure CheckExportFieldNames(const MaxFieldNameLength: integer); virtual; Procedure CheckExportFieldName(ThisExportField: TExportFieldItem; const MaxFieldNameLength: integer);
Function BindFields : Boolean; override; Function BindFields : Boolean; override;
Function CreateFormatSettings : TCustomExportFormatSettings; override; Function CreateFormatSettings : TCustomExportFormatSettings; override;
@ -97,31 +97,30 @@ begin
Inherited FormatSettings.Assign(AValue); Inherited FormatSettings.Assign(AValue);
end; end;
procedure TFPCustomDBFExport.CheckExportFieldNames(const MaxFieldNameLength: integer); procedure TFPCustomDBFExport.CheckExportFieldName(ThisExportField: TExportFieldItem; const MaxFieldNameLength: integer);
// Cut off field name at max length, and rename if it already exists
Const
CounterInvalid=100;
Var Var
i,NameCounter : Integer; NameCounter : Integer;
EF : TExportFieldItem;
NewFieldName : String; NewFieldName : String;
begin begin
For i:=0 to ExportFields.Count-1 do If (Length(ThisExportField.ExportedName)>MaxFieldNameLength) then
begin begin
EF:=ExportFields[i]; NewFieldName:=Copy(ThisExportField.ExportedName,1,MaxFieldNameLength);
{ Cut off field name at max length, and If ExportFields.IndexOfExportedName(NewFieldName)<>-1 then
rename if it already exists:}
If (Length(EF.ExportedName)>MaxFieldNameLength) then
begin begin
NewFieldName:=Copy(EF.ExportedName,1,MaxFieldNameLength); // Try using 2-character number sequence to generate unique name
If ExportFields.IndexOfExportedName(NewFieldName)<>-1 then NameCounter:=1;
begin Repeat
NameCounter:=1; NewFieldName:=Copy(ThisExportField.ExportedName,1,MaxFieldNameLength-2)+Format('%.2d',[NameCounter]);
Repeat Until (ExportFields.IndexOfExportedName(NewFieldName)=-1) or (NameCounter=CounterInvalid);
NewFieldName:=Copy(EF.ExportedName,1,8)+Format('%.2d',[NameCounter]); if NameCounter=CounterInvalid then
Until (ExportFIelds.IndexOfExportedName(NewFieldName)=-1); ExportError('Could not create a unique export field name for field %s',[ThisExportField.FieldName]);
end;
EF.ExportedName:=NewFieldName;
end; end;
ThisExportField.ExportedName:=NewFieldName;
end; end;
end; end;
@ -134,16 +133,17 @@ Const
Var Var
EF : TDBFExportFieldItem; EF : TDBFExportFieldItem;
i : Integer; i : Integer;
MaxFieldName: integer;
begin begin
Result:=Inherited;
// DBase III,IV, and FoxPro have a 10 character field length limit. // DBase III,IV, and FoxPro have a 10 character field length limit.
// Visual Foxpro free tables (without .dbc file) also // Visual Foxpro free tables (without .dbc file) also
If FormatSettings.AutoRenameFields and (FormatSettings.TableFormat in [tfDbaseIII,tfDbaseIV,tfFoxPro,tfVisualFoxPro]) then
CheckExportFieldNames(10);
// DBase VII has a 32 character field length limit. // DBase VII has a 32 character field length limit.
If FormatSettings.AutoRenameFields and (FormatSettings.TableFormat=tfDbaseVII) then if (FormatSettings.TableFormat=tfDbaseVII) then
CheckExportFieldNames(32); MaxFieldName:=32
Result:=Inherited; else
MaxFieldName:=10;
try try
with FDBF.FieldDefs do with FDBF.FieldDefs do
begin begin
@ -151,6 +151,8 @@ begin
For i:=0 to ExportFields.Count-1 do For i:=0 to ExportFields.Count-1 do
begin begin
EF:=ExportFields[i] as TDBFExportFieldItem; EF:=ExportFields[i] as TDBFExportFieldItem;
If FormatSettings.AutoRenameFields then
CheckExportFieldName(EF,MaxFieldName);
If EF.Enabled and Assigned(EF.Field) then If EF.Enabled and Assigned(EF.Field) then
Add(EF.ExportedName,EF.Field.DataType,EF.Field.Size); Add(EF.ExportedName,EF.Field.DataType,EF.Field.Size);
end; end;