BDE dbidorestructure returns 空 table
BDE dbidorestructure returns empty table
在我的（Delphi Sydney，Win 10）应用程序中，我使用 BDE（即使在今天也是）。
当我 change/alter/drop 字段时，我想修改其存在的 (Paradox) tables。
我找到了一个免费软件组件（TFieldUpdate v1.1，由 Nathanial Woolls 开发），除了它不能删除字段并一次为一个字段工作外，它可以正常工作。
所以我在这里 (http://www.delphigroups.info/2/5a/37309.html) 找到了另一个没有这些限制的代码片段。我修改如下
procedure RestructureTable;
var
dirP: DBITBLNAME;
hDb: hDbiDb;
rslt: DBIResult;
TblDesc: CRTblDesc;
CProps: CURProps;
PfldDescOldTable, PfldDescNewTable: pFLDDesc;
pOpType, pOpType0: pCROpType;
bdec : TBDECallback;
i: Integer;
s: String;
oldTable : TTable;
const fieldsModified : boolean = FALSE;
fieldsAdded : boolean = FALSE;
fieldsDroped : boolean = FALSE;
function oldFieldFound : integer;
var j : integer;
begin
result := -1;
for j := 0 to T.Fields.Count - 1 do begin
if compareText(PfldDescOldTable^.szName,T.Fields[j].fieldName) = 0
then begin
result := j;
break;
end;
end;
end;
function newFieldFound(s : string) : boolean;
var p: pFLDDesc;
var i : integer;
begin
result := FALSE;
p := PfldDescOldTable;
for i := 0 to TblDesc.iFldCount-1 do begin
if compareText(p^.szName,s) = 0
then begin
result := TRUE;
break;
end;
inc(p);
end;
end;
begin
// Table must not used by other user
s := changeFileExt(T.DatabaseName+'\'+T.TableName,'.lck');
F := TFilestream.Create(s,fmCreate or fmShareExclusive);
oldTable := TTable.Create(nil);
oldTable.DatabaseName := T.DatabaseName;
oldTable.TableName := T.TableName;
oldTable.Open;
Check(DbiGetDirectory(oldTable.DBHandle, False, dirP));
Check(DbiGetCursorProps(oldTable.Handle, CProps));
nFields := CProps.iFields;
if nFields < T.Fields.Count
then nFields := T.Fields.Count;
PfldDescOldTable := allocMem(nFields * sizeof(FLDDesc));
PfldDescNewTable := PfldDescOldTable;
pOpType := allocMem(nFields * sizeof(CROpType));
pOpType0 := pOpType;
try
Check(DbiGetFieldDescs(oldTable.Handle, PfldDescOldTable));
FillChar(TblDesc, sizeof(CRTblDesc), #0);
StrPCopy(TblDesc.szTblName, oldTable.TableName);
StrCopy(TblDesc.szTblType, szParadox);
TblDesc.iFldCount := 0;
FillChar(pOpType^, nFields * sizeof(CROpType), #0);
for i := 1 to CProps.iFields do begin
PfldDescOldTable^.iFldNum := 0;
pOpType^ := crADD;
j := oldFieldFound; // j = field.index (0...)
if j > -1 // if field remains... add it to TblDesc
then begin
Inc(TblDesc.iFldCount);
if PfldDescNewTable <> PfldDescOldTable then
Move(PfldDescOldTable^,PfldDescNewTable^,sizeof(FLDDesc));
if PfldDescNewTable^.iFldType <> FieldTypeToBDEFieldInt(T.Fields[j].DataType)
then begin
PfldDescNewTable^.iFldType := FieldTypeToBDEFieldInt(T.Fields[j].DataType);
fieldsModified := TRUE;
end;
if PfldDescNewTable^.iFldType <> FieldTypeToBDEFieldInt(T.Fields[j].DataType)
then begin
PfldDescNewTable^.iFldType := FieldTypeToBDEFieldInt(T.Fields[j].DataType);
fieldsModified := TRUE;
end;
if PfldDescNewTable^.iUnits1 <> T.Fields[j].Size
then begin
PfldDescNewTable^.iUnits1 := T.Fields[j].Size;
fieldsModified := TRUE;
end;
inc(PfldDescNewTable,1);
end
else fieldsDroped := TRUE; // else drop it
inc(PfldDescOldTable,1);
inc(pOpType,1);
end;
dec(PfldDescOldTable ,CProps.iFields);
// add new fields
for i := 0 to T.Fields.Count-1 do
if T.fields[i].FieldKind = fkData then
begin
if not newFieldFound(T.fields[i].FieldName) then begin // add it to TblDesc
StrCopy(PfldDescNewTable^.szName, pANSIchar(AnsiString(T.fields[i].FieldName)));
PfldDescNewTable^.iFldType := FieldTypeToBDEFieldInt(T.Fields[i].DataType);
PfldDescNewTable^.iUnits1 := T.Fields[i].Size;
Inc(TblDesc.iFldCount);
pOpType^ := crADD;
inc(PfldDescNewTable,1);
inc(pOpType,1);
fieldsAdded := TRUE;
end;
end;
PfldDescNewTable := PfldDescOldTable;
pOpType := pOpType0;
TblDesc.pecrFldOp := pOpType;
TblDesc.pfldDesc := PfldDescNewTable;
oldTable.Close;
if fieldsModified
or fieldsAdded
or fieldsDroped then begin
//bdec := TBDECallback.Create(nil,oldTable.Handle,cbGENPROGRESS,@cbDataBuff, SizeOf(cbDataBuff),ProgressCallback,TRUE) ;
Check(DbiOpenDatabase(nil, nil, dbiReadWrite, dbiOpenExcl, nil, 0,nil, nil, hDb));
Check(DbiSetDirectory(hDb, Dirp));
Check(DbiDoRestructure(hDb, 1, @TblDesc, nil , nil, nil, FALSE));
end;
finally
FreeMem(PfldDescOldTable, (CProps.iFields) * sizeof(FLDDesc));
FreeMem(pOpType, (CProps.iFields ) * sizeof(CROpType));
oldTable.Free;
F.Free;
//bdec.Free;
deleteFile(s);
end;
end;
它工作正常，除了它 returns 修改了 table 所有记录，但它们的字段为空。
我删除了所有索引和所有非数据字段，问题仍然存在。
有人可以告诉我我错过了什么吗？
编辑
重现问题：
- 创建新的 VCL 表单应用程序
- 将名为 T 的 TTable 组件和 link 放入现有的 Paradox table
- 将 TDataSource 和 TDBGrid link 与 table T
合并
- 在字段编辑器中加载所有字段
- Modify/add/drop其中一些
- 在 onFormCreate 事件中 运行 上面的例程，你将得到重组的 table 所有记录的所有字段都没有值（空）
编辑 2：
```
function FieldTypeToBDEFieldInt(FieldType: TFieldType): Word;
begin
Result := fldUNKNOWN;
case FieldType of
ftUnknown : result := fldUNKNOWN;
ftString : result := fldZSTRING;
ftSmallint : result := fldPDXSHORT;
ftInteger : result := 267; //fldINT16;// I changed it to 267 because this value i see in the table's field descriptor (with fldINT32 = ftLargeInt = 6 I had uncompatibility)
ftWord : result := fldUINT16;
ftBoolean : result := fldBOOL;
ftFloat : result := fldFLOAT;
ftCurrency : result := fldPDXMONEY;
ftBCD : result := fldBCD;
ftDate : result := fldDATE;
ftTime : result := fldTIME;
ftDateTime : result := fldPDXDATETIME;
ftBytes : result := fldBYTES;
ftVarBytes : result := fldVARBYTES;
ftAutoInc : result := fldPDXAUTOINC;
ftBlob : result := fldPDXBINARYBLOB; //fldBLOB;
ftMemo : result := fldPDXMEMO;
ftGraphic : result := fldPDXGRAPHIC;
ftFmtMemo : result := fldPDXFMTMEMO;
ftParadoxOle : result := fldPDXOLEBLOB;
ftTypedBinary : result := fldPDXBINARYBLOB;
ftCursor : result := fldCURSOR;
ftFixedChar : result := fldPDXCHAR;
ftWideString : result := fldZSTRING;
ftLargeInt : result := fldINT32;
ftADT : result := fldADT;
ftArray : result := fldARRAY;
ftReference : result := fldREF;
ftVariant : result := fldUNKNOWN;
end;
end;
我花了好几个小时修改你的代码，但还是无济于事，所以我又从头开始了。我想您会发现下面的代码正确地从 TTable 中删除了一个字段，同时保留了剩余记录字段的正确内容。
DeleteField 例程是一个独立的过程，但您会发现它可以直接与现有代码集成。如果您想添加或修改字段，我建议您从 link 中发布的 Sprenger 先生的代码开始。就个人而言，如果我是你，我会放弃你的 RestructureTable，因为我认为它无法挽救，恐怕。
我的主窗体有一个名为 DestTable 的 TTable、一个 DBGrid 和一个数据源，正如您所期望的那样。然后我添加下面的代码。
procedure TForm1.CreateTable(T : TTable);
var
AField : TField;
begin
AField := TIntegerField.Create(T);
AField.FieldName := 'Field1';
AField.DataSet := T;
AField := TStringField.Create(T);
AField.FieldName := 'Field2';
AField.DataSet := T;
AField.Size := 20;
AField := TStringField.Create(T);
AField.FieldName := 'Field3';
AField.DataSet := T;
AField.Size := 20;
T.Exclusive := True;
T.CreateTable;
T.Open;
T.InsertRecord([1, 'r1f1', 'r1f2']);
T.InsertRecord([2, 'r2f1', 'r2f2']);
T.InsertRecord([3, 'r3f1', 'r3f3']);
end;
我在代码中创建并填充了 table，这样代码是独立的，不依赖于任何现有的 table。
然后我添加这个DeleteField方法：
procedure DeleteField(Table: TTable; Field: TField);
(*
based on a post by Jason Sprenge on Wed, 29 May 2002 03:00:00 GMT in
this thread http://www.delphigroups.info/2/48/359769.html
*)
type
TFieldArray = Array[0..1000] of FLDDesc;
PFieldArray = ^TFieldArray;
var
Props: CURProps;
hDb: hDBIDb;
TableDesc: CRTblDesc;
pOldFields,
pNewFields,
pCurField: pFLDDesc;
pOp, pCurOp: pCROpType;
ItrFld: Word;
i,
j : Integer;
POldFieldArray,
PNewFieldArray : PFieldArray;
OldFieldsArraySize,
NewFieldsArraySize : Integer;
begin
// Initialize the pointers...
pOldFields := nil;
pNewFields := Nil;
pOp := nil;
// Make sure the table is open exclusively so we can restructure..
if not Table.Active then
raise EDatabaseError.Create('Table must be opened '+
'to restructure');
if not Table.Exclusive then
raise EDatabaseError.Create('Table must be opened exclusively ' +
'to restructure');
// Set the cursor in physical translation mode
Check(DbiSetProp(hDBIObj(Table.Handle), curxltMODE, Ord(xltNONE)));
// Get the table properties to determine table type...
Check(DbiGetCursorProps(Table.Handle, Props));
// Make sure the table is either Paradox, dBASE or FoxPro...
if (Props.szTableType <> szPARADOX) and
(Props.szTableType <> szDBASE) and
(Props.szTableType <> szFOXPRO) then
raise EDatabaseError.Create('Field altering can only occur on '+
'Paradox, dBASE or FoxPro tables');
try
// Allocate memory for the field descriptor...
OldFieldsArraySize := Props.iFields * sizeof(FLDDesc);
NewFieldsArraySize := (Props.iFields - 1) * sizeof(FLDDesc);
pOldFields := AllocMem(OldFieldsArraySize);
pNewFields := AllocMem(NewFieldsArraySize);
// Allocate memory for the operation descriptor...
pOp := AllocMem(Props.iFields * sizeof(CROpType));
// Null out the operations (= crNOOP)...
FillChar(pOp^, Props.iFields * sizeof(CROpType), #0);
// Set the pointer to the index in the operation descriptor to put
pCurOp := pOp;
Inc(pCurOp, Field.FieldNo - 1);
pCurOp^ := crNoOp;
// Fill field descriptor with the existing field information...
Check(DbiGetFieldDescs(Table.Handle, pOldFields));
// Set pointer to the index in the field descriptor to make the
// modifications to the field
pCurField := pOldFields;
Inc(pCurField, Field.FieldNo - 1);
pCurField := pOldFields;
for ItrFld := 1 to Props.iFields do begin
pCurField^.iFldNum := ItrFld;
Inc(pCurField, 1);
end;
j := 0;
i := 0;
POldFieldArray := PFieldArray(pointer(pOldFields));
PNewFieldArray := PFieldArray(pointer(pNewFields));
for i := 0 to Table.FieldCount - 1 do begin
if Table.Fields[i] <> Field then begin
pNewFieldArray^[j] := pOldFieldArray^[i];
Inc(j);
end;
end;
// Blank out the structure...
FillChar(TableDesc, sizeof(TableDesc), #0);
// Get the database handle from the table's cursor handle...
hDb := Table.DBHandle;
// Put the table name in the table descriptor...
StrPCopy(TableDesc.szTblName, Table.TableName);
// Put the table type in the table descriptor...
StrCopy(TableDesc.szTblType, Props.szTableType);
// The following three lines are necessary when doing any field
// restructure operations on a table...
// Set the field count for the table
TableDesc.iFldCount := Props.iFields - 1{MA};
// Link the operation descriptor to the table descriptor...
TableDesc.pecrFldOp := pOp;
// Link the field descriptor to the table descriptor...
TableDesc.pFldDesc := pNewFields;
// Close the table so the restructure can complete...
Table.Close;
// Read restructure action...
Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False));
finally
if (pOldFields <> nil) then
FreeMem(pOldFields);
if (pNewFields <> nil) then
FreeMem(pNewFields);
if (pOp <> nil) then
FreeMem(pOp);
end;
end;
从字段索引指定的 table 中删除一个字段。
然后我添加
procedure TForm1.btnRestructClick(Sender: TObject);
var
AField : TField;
begin
CreateTable(DestTable);
if not DestTable.Active then
DestTable.Open;
// Select a field to be deleted
AField := DestTable.FieldByName('Field2');
DeleteField(DestTable, AField);
DestTable.Fields.Clear;
if not DestTable.Active then
DestTable.Open;
end;
调用 btnRestructClick 正确重构 table 删除 Field2 并且 DestTable 可以使用正确的结构 和 内容保存到磁盘。
在我的（Delphi Sydney，Win 10）应用程序中，我使用 BDE（即使在今天也是）。 当我 change/alter/drop 字段时，我想修改其存在的 (Paradox) tables。 我找到了一个免费软件组件（TFieldUpdate v1.1，由 Nathanial Woolls 开发），除了它不能删除字段并一次为一个字段工作外，它可以正常工作。 所以我在这里 (http://www.delphigroups.info/2/5a/37309.html) 找到了另一个没有这些限制的代码片段。我修改如下
procedure RestructureTable;
var
dirP: DBITBLNAME;
hDb: hDbiDb;
rslt: DBIResult;
TblDesc: CRTblDesc;
CProps: CURProps;
PfldDescOldTable, PfldDescNewTable: pFLDDesc;
pOpType, pOpType0: pCROpType;
bdec : TBDECallback;
i: Integer;
s: String;
oldTable : TTable;
const fieldsModified : boolean = FALSE;
fieldsAdded : boolean = FALSE;
fieldsDroped : boolean = FALSE;
function oldFieldFound : integer;
var j : integer;
begin
result := -1;
for j := 0 to T.Fields.Count - 1 do begin
if compareText(PfldDescOldTable^.szName,T.Fields[j].fieldName) = 0
then begin
result := j;
break;
end;
end;
end;
function newFieldFound(s : string) : boolean;
var p: pFLDDesc;
var i : integer;
begin
result := FALSE;
p := PfldDescOldTable;
for i := 0 to TblDesc.iFldCount-1 do begin
if compareText(p^.szName,s) = 0
then begin
result := TRUE;
break;
end;
inc(p);
end;
end;
begin
// Table must not used by other user
s := changeFileExt(T.DatabaseName+'\'+T.TableName,'.lck');
F := TFilestream.Create(s,fmCreate or fmShareExclusive);
oldTable := TTable.Create(nil);
oldTable.DatabaseName := T.DatabaseName;
oldTable.TableName := T.TableName;
oldTable.Open;
Check(DbiGetDirectory(oldTable.DBHandle, False, dirP));
Check(DbiGetCursorProps(oldTable.Handle, CProps));
nFields := CProps.iFields;
if nFields < T.Fields.Count
then nFields := T.Fields.Count;
PfldDescOldTable := allocMem(nFields * sizeof(FLDDesc));
PfldDescNewTable := PfldDescOldTable;
pOpType := allocMem(nFields * sizeof(CROpType));
pOpType0 := pOpType;
try
Check(DbiGetFieldDescs(oldTable.Handle, PfldDescOldTable));
FillChar(TblDesc, sizeof(CRTblDesc), #0);
StrPCopy(TblDesc.szTblName, oldTable.TableName);
StrCopy(TblDesc.szTblType, szParadox);
TblDesc.iFldCount := 0;
FillChar(pOpType^, nFields * sizeof(CROpType), #0);
for i := 1 to CProps.iFields do begin
PfldDescOldTable^.iFldNum := 0;
pOpType^ := crADD;
j := oldFieldFound; // j = field.index (0...)
if j > -1 // if field remains... add it to TblDesc
then begin
Inc(TblDesc.iFldCount);
if PfldDescNewTable <> PfldDescOldTable then
Move(PfldDescOldTable^,PfldDescNewTable^,sizeof(FLDDesc));
if PfldDescNewTable^.iFldType <> FieldTypeToBDEFieldInt(T.Fields[j].DataType)
then begin
PfldDescNewTable^.iFldType := FieldTypeToBDEFieldInt(T.Fields[j].DataType);
fieldsModified := TRUE;
end;
if PfldDescNewTable^.iFldType <> FieldTypeToBDEFieldInt(T.Fields[j].DataType)
then begin
PfldDescNewTable^.iFldType := FieldTypeToBDEFieldInt(T.Fields[j].DataType);
fieldsModified := TRUE;
end;
if PfldDescNewTable^.iUnits1 <> T.Fields[j].Size
then begin
PfldDescNewTable^.iUnits1 := T.Fields[j].Size;
fieldsModified := TRUE;
end;
inc(PfldDescNewTable,1);
end
else fieldsDroped := TRUE; // else drop it
inc(PfldDescOldTable,1);
inc(pOpType,1);
end;
dec(PfldDescOldTable ,CProps.iFields);
// add new fields
for i := 0 to T.Fields.Count-1 do
if T.fields[i].FieldKind = fkData then
begin
if not newFieldFound(T.fields[i].FieldName) then begin // add it to TblDesc
StrCopy(PfldDescNewTable^.szName, pANSIchar(AnsiString(T.fields[i].FieldName)));
PfldDescNewTable^.iFldType := FieldTypeToBDEFieldInt(T.Fields[i].DataType);
PfldDescNewTable^.iUnits1 := T.Fields[i].Size;
Inc(TblDesc.iFldCount);
pOpType^ := crADD;
inc(PfldDescNewTable,1);
inc(pOpType,1);
fieldsAdded := TRUE;
end;
end;
PfldDescNewTable := PfldDescOldTable;
pOpType := pOpType0;
TblDesc.pecrFldOp := pOpType;
TblDesc.pfldDesc := PfldDescNewTable;
oldTable.Close;
if fieldsModified
or fieldsAdded
or fieldsDroped then begin
//bdec := TBDECallback.Create(nil,oldTable.Handle,cbGENPROGRESS,@cbDataBuff, SizeOf(cbDataBuff),ProgressCallback,TRUE) ;
Check(DbiOpenDatabase(nil, nil, dbiReadWrite, dbiOpenExcl, nil, 0,nil, nil, hDb));
Check(DbiSetDirectory(hDb, Dirp));
Check(DbiDoRestructure(hDb, 1, @TblDesc, nil , nil, nil, FALSE));
end;
finally
FreeMem(PfldDescOldTable, (CProps.iFields) * sizeof(FLDDesc));
FreeMem(pOpType, (CProps.iFields ) * sizeof(CROpType));
oldTable.Free;
F.Free;
//bdec.Free;
deleteFile(s);
end;
end;
它工作正常，除了它 returns 修改了 table 所有记录，但它们的字段为空。
我删除了所有索引和所有非数据字段，问题仍然存在。
有人可以告诉我我错过了什么吗？
编辑
重现问题：
- 创建新的 VCL 表单应用程序
- 将名为 T 的 TTable 组件和 link 放入现有的 Paradox table
- 将 TDataSource 和 TDBGrid link 与 table T 合并
- 在字段编辑器中加载所有字段
- Modify/add/drop其中一些
- 在 onFormCreate 事件中 运行 上面的例程，你将得到重组的 table 所有记录的所有字段都没有值（空）
编辑 2：
```
function FieldTypeToBDEFieldInt(FieldType: TFieldType): Word;
begin
Result := fldUNKNOWN;
case FieldType of
ftUnknown : result := fldUNKNOWN;
ftString : result := fldZSTRING;
ftSmallint : result := fldPDXSHORT;
ftInteger : result := 267; //fldINT16;// I changed it to 267 because this value i see in the table's field descriptor (with fldINT32 = ftLargeInt = 6 I had uncompatibility)
ftWord : result := fldUINT16;
ftBoolean : result := fldBOOL;
ftFloat : result := fldFLOAT;
ftCurrency : result := fldPDXMONEY;
ftBCD : result := fldBCD;
ftDate : result := fldDATE;
ftTime : result := fldTIME;
ftDateTime : result := fldPDXDATETIME;
ftBytes : result := fldBYTES;
ftVarBytes : result := fldVARBYTES;
ftAutoInc : result := fldPDXAUTOINC;
ftBlob : result := fldPDXBINARYBLOB; //fldBLOB;
ftMemo : result := fldPDXMEMO;
ftGraphic : result := fldPDXGRAPHIC;
ftFmtMemo : result := fldPDXFMTMEMO;
ftParadoxOle : result := fldPDXOLEBLOB;
ftTypedBinary : result := fldPDXBINARYBLOB;
ftCursor : result := fldCURSOR;
ftFixedChar : result := fldPDXCHAR;
ftWideString : result := fldZSTRING;
ftLargeInt : result := fldINT32;
ftADT : result := fldADT;
ftArray : result := fldARRAY;
ftReference : result := fldREF;
ftVariant : result := fldUNKNOWN;
end;
end;
我花了好几个小时修改你的代码，但还是无济于事，所以我又从头开始了。我想您会发现下面的代码正确地从 TTable 中删除了一个字段，同时保留了剩余记录字段的正确内容。
DeleteField 例程是一个独立的过程，但您会发现它可以直接与现有代码集成。如果您想添加或修改字段，我建议您从 link 中发布的 Sprenger 先生的代码开始。就个人而言，如果我是你，我会放弃你的 RestructureTable，因为我认为它无法挽救，恐怕。
我的主窗体有一个名为 DestTable 的 TTable、一个 DBGrid 和一个数据源，正如您所期望的那样。然后我添加下面的代码。
procedure TForm1.CreateTable(T : TTable);
var
AField : TField;
begin
AField := TIntegerField.Create(T);
AField.FieldName := 'Field1';
AField.DataSet := T;
AField := TStringField.Create(T);
AField.FieldName := 'Field2';
AField.DataSet := T;
AField.Size := 20;
AField := TStringField.Create(T);
AField.FieldName := 'Field3';
AField.DataSet := T;
AField.Size := 20;
T.Exclusive := True;
T.CreateTable;
T.Open;
T.InsertRecord([1, 'r1f1', 'r1f2']);
T.InsertRecord([2, 'r2f1', 'r2f2']);
T.InsertRecord([3, 'r3f1', 'r3f3']);
end;
我在代码中创建并填充了 table，这样代码是独立的，不依赖于任何现有的 table。
然后我添加这个DeleteField方法：
procedure DeleteField(Table: TTable; Field: TField);
(*
based on a post by Jason Sprenge on Wed, 29 May 2002 03:00:00 GMT in
this thread http://www.delphigroups.info/2/48/359769.html
*)
type
TFieldArray = Array[0..1000] of FLDDesc;
PFieldArray = ^TFieldArray;
var
Props: CURProps;
hDb: hDBIDb;
TableDesc: CRTblDesc;
pOldFields,
pNewFields,
pCurField: pFLDDesc;
pOp, pCurOp: pCROpType;
ItrFld: Word;
i,
j : Integer;
POldFieldArray,
PNewFieldArray : PFieldArray;
OldFieldsArraySize,
NewFieldsArraySize : Integer;
begin
// Initialize the pointers...
pOldFields := nil;
pNewFields := Nil;
pOp := nil;
// Make sure the table is open exclusively so we can restructure..
if not Table.Active then
raise EDatabaseError.Create('Table must be opened '+
'to restructure');
if not Table.Exclusive then
raise EDatabaseError.Create('Table must be opened exclusively ' +
'to restructure');
// Set the cursor in physical translation mode
Check(DbiSetProp(hDBIObj(Table.Handle), curxltMODE, Ord(xltNONE)));
// Get the table properties to determine table type...
Check(DbiGetCursorProps(Table.Handle, Props));
// Make sure the table is either Paradox, dBASE or FoxPro...
if (Props.szTableType <> szPARADOX) and
(Props.szTableType <> szDBASE) and
(Props.szTableType <> szFOXPRO) then
raise EDatabaseError.Create('Field altering can only occur on '+
'Paradox, dBASE or FoxPro tables');
try
// Allocate memory for the field descriptor...
OldFieldsArraySize := Props.iFields * sizeof(FLDDesc);
NewFieldsArraySize := (Props.iFields - 1) * sizeof(FLDDesc);
pOldFields := AllocMem(OldFieldsArraySize);
pNewFields := AllocMem(NewFieldsArraySize);
// Allocate memory for the operation descriptor...
pOp := AllocMem(Props.iFields * sizeof(CROpType));
// Null out the operations (= crNOOP)...
FillChar(pOp^, Props.iFields * sizeof(CROpType), #0);
// Set the pointer to the index in the operation descriptor to put
pCurOp := pOp;
Inc(pCurOp, Field.FieldNo - 1);
pCurOp^ := crNoOp;
// Fill field descriptor with the existing field information...
Check(DbiGetFieldDescs(Table.Handle, pOldFields));
// Set pointer to the index in the field descriptor to make the
// modifications to the field
pCurField := pOldFields;
Inc(pCurField, Field.FieldNo - 1);
pCurField := pOldFields;
for ItrFld := 1 to Props.iFields do begin
pCurField^.iFldNum := ItrFld;
Inc(pCurField, 1);
end;
j := 0;
i := 0;
POldFieldArray := PFieldArray(pointer(pOldFields));
PNewFieldArray := PFieldArray(pointer(pNewFields));
for i := 0 to Table.FieldCount - 1 do begin
if Table.Fields[i] <> Field then begin
pNewFieldArray^[j] := pOldFieldArray^[i];
Inc(j);
end;
end;
// Blank out the structure...
FillChar(TableDesc, sizeof(TableDesc), #0);
// Get the database handle from the table's cursor handle...
hDb := Table.DBHandle;
// Put the table name in the table descriptor...
StrPCopy(TableDesc.szTblName, Table.TableName);
// Put the table type in the table descriptor...
StrCopy(TableDesc.szTblType, Props.szTableType);
// The following three lines are necessary when doing any field
// restructure operations on a table...
// Set the field count for the table
TableDesc.iFldCount := Props.iFields - 1{MA};
// Link the operation descriptor to the table descriptor...
TableDesc.pecrFldOp := pOp;
// Link the field descriptor to the table descriptor...
TableDesc.pFldDesc := pNewFields;
// Close the table so the restructure can complete...
Table.Close;
// Read restructure action...
Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False));
finally
if (pOldFields <> nil) then
FreeMem(pOldFields);
if (pNewFields <> nil) then
FreeMem(pNewFields);
if (pOp <> nil) then
FreeMem(pOp);
end;
end;
从字段索引指定的 table 中删除一个字段。
然后我添加
procedure TForm1.btnRestructClick(Sender: TObject);
var
AField : TField;
begin
CreateTable(DestTable);
if not DestTable.Active then
DestTable.Open;
// Select a field to be deleted
AField := DestTable.FieldByName('Field2');
DeleteField(DestTable, AField);
DestTable.Fields.Clear;
if not DestTable.Active then
DestTable.Open;
end;
调用 btnRestructClick 正确重构 table 删除 Field2 并且 DestTable 可以使用正确的结构 和 内容保存到磁盘。