paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:09:27 +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;
procedure SetSettings(const AValue: TDBFExportFormatSettings);
Protected
Procedure CheckExportFieldNames(const MaxFieldNameLength: integer); virtual;
Procedure CheckExportFieldName(ThisExportField: TExportFieldItem; const MaxFieldNameLength: integer);
Function BindFields : Boolean; override;
Function CreateFormatSettings : TCustomExportFormatSettings; override;
@ -97,31 +97,30 @@ begin
Inherited FormatSettings.Assign(AValue);
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
i,NameCounter : Integer;
EF : TExportFieldItem;
NameCounter : Integer;
NewFieldName : String;
begin
For i:=0 to ExportFields.Count-1 do
If (Length(ThisExportField.ExportedName)>MaxFieldNameLength) then
begin
EF:=ExportFields[i];
{ Cut off field name at max length, and
rename if it already exists:}
If (Length(EF.ExportedName)>MaxFieldNameLength) then
NewFieldName:=Copy(ThisExportField.ExportedName,1,MaxFieldNameLength);
If ExportFields.IndexOfExportedName(NewFieldName)<>-1 then
begin
NewFieldName:=Copy(EF.ExportedName,1,MaxFieldNameLength);
If ExportFields.IndexOfExportedName(NewFieldName)<>-1 then
begin
NameCounter:=1;
Repeat
NewFieldName:=Copy(EF.ExportedName,1,8)+Format('%.2d',[NameCounter]);
Until (ExportFIelds.IndexOfExportedName(NewFieldName)=-1);
end;
EF.ExportedName:=NewFieldName;
// Try using 2-character number sequence to generate unique name
NameCounter:=1;
Repeat
NewFieldName:=Copy(ThisExportField.ExportedName,1,MaxFieldNameLength-2)+Format('%.2d',[NameCounter]);
Until (ExportFields.IndexOfExportedName(NewFieldName)=-1) or (NameCounter=CounterInvalid);
if NameCounter=CounterInvalid then
ExportError('Could not create a unique export field name for field %s',[ThisExportField.FieldName]);
end;
ThisExportField.ExportedName:=NewFieldName;
end;
end;
@ -134,16 +133,17 @@ Const
Var
EF : TDBFExportFieldItem;
i : Integer;
MaxFieldName: integer;
begin
Result:=Inherited;
// DBase III,IV, and FoxPro have a 10 character field length limit.
// 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.
If FormatSettings.AutoRenameFields and (FormatSettings.TableFormat=tfDbaseVII) then
CheckExportFieldNames(32);
Result:=Inherited;
if (FormatSettings.TableFormat=tfDbaseVII) then
MaxFieldName:=32
else
MaxFieldName:=10;
try
with FDBF.FieldDefs do
begin
@ -151,6 +151,8 @@ begin
For i:=0 to ExportFields.Count-1 do
begin
EF:=ExportFields[i] as TDBFExportFieldItem;
If FormatSettings.AutoRenameFields then
CheckExportFieldName(EF,MaxFieldName);
If EF.Enabled and Assigned(EF.Field) then
Add(EF.ExportedName,EF.Field.DataType,EF.Field.Size);
end;