即使花了几个小时,我也无法尝试纠正你的代码,所以我又从头开始。我想您会发现下面的代码正确地从 TTable 中删除了一个字段,同时保留了剩余记录字段的正确内容。
The DeleteField
例程是一个独立的过程,但您应该会发现它可以直接与现有代码集成。如果您想添加或修改字段,我建议您从链接中发布的 Sprenger 先生的代码开始。就我个人而言,如果我是你,我会放弃你的 RestructionTable,因为我认为它无法挽救,恐怕。
我的主窗体有一个名为DestTable
、一个 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;
我在代码中创建并填充表,以便代码是独立的并且不依赖于任何现有表。
然后我添加这个DeleteField
method:
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;
它从字段索引指定的表中删除字段。
然后我添加
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;
Calling btnRestructClick
正确地重构表并删除Field2
并且 DestTable 可以以正确的结构保存到磁盘and内容。