本文介绍了BDE dbidorestructure返回空表的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

在我的(Delphi Sydney,Win 10)应用程序中,我使用了BDE(即使在今天也是).当我更改/更改/删除字段时,我想修改它的现有(Paradox)表.我发现了一个免费软件组件(Nathanial Woolls的TFieldUpdate v1.1)可以工作,除了它不能删除字段并且一次只能为一个字段工作.所以我在这里找到了( http://www.delphigroups.info/2/5a/37309.html )另一个没有这些限制的代码段.我将其修改为波纹管

In my (Delphi Sydney, Win 10) application I use BDE (yes even today).I want to modify its existed (Paradox) tables when I change/alter/drop fields.I found a freeware component (TFieldUpdate v1.1, by Nathanial Woolls) that works except that it can't drop fields and works for a field at a time.So I found here (http://www.delphigroups.info/2/5a/37309.html) another code snipet that hasn't these limitations. I modified it as bellow

    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;

,它工作正常,只不过它返回更改后的表,其中所有记录但其字段为空.

and it works fine except that it returns the altered table with all records but their fields empty.

我删除了所有索引和所有非数据字段,问题仍然存在.

I delete all indexes and all non data fields and the problem remains.

有人可以告诉我我错过了什么吗?

Can somebody tell me what i missed, please ?

编辑

重现问题:

  1. 创建一个新的VCL表单应用程序
  2. 放置一个名为T的TTable组件并将其链接到现有的Paradox表
  3. 放置与表T链接的TDataSource和TDBGrid
  4. 在字段编辑器中加载所有字段
  5. 修改/添加/删除其中一些
  6. 在onFormCreate事件中,运行上面的例程,您将获得具有所有记录的所有字段且无值(空)的重组表
```
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中删除了一个字段,同时保留了其余记录字段的正确内容.

I got nowhere trying to correct your code even after spending several hours on it, so I started again from scratch. I think you will find that the code below correctly removes a field from a TTable while retaining the correct contents of the remaining record fields.

DeleteField 例程是一个独立的过程,但是您应该发现它很容易与现有代码集成.如果要添加或修改字段,建议您从链接中发布的Sprenger先生的代码开始.就我个人而言,恐怕我会放弃您的RestructureTable,因为我认为这不是可挽救的.

The DeleteField routine is a stand-alone procedure, but you should find it straightforward to integrate with your existing code. If you want to add or modify fields, I suggest that you start from Mr Sprenger's code as posted in the link. Personally, if I were you I would abandon your RestructureTable as I don't think it is salvageable, I'm afraid.

我的主表单有一个名为 DestTable 的TTable,一个DBGrid和一个数据源,可以按照您的期望进行连接.然后,我在下面添加代码.

My Main form has a TTable named DestTable, a DBGrid and a Datasource connected up as you would expect. I then add the code below.

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;

我用代码创建并填充该表,以便该代码是独立的并且不依赖于任何现有表.

I create and populate the table in code so that the code is self-contained and doesn't depend on any existing 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;

从其字段索引指定的表中删除该字段.

which removes a field from the table specified by its field index.

然后我添加

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 可以重组表,从而删除 Field2 ,并且DestTable可以使用正确的结构内容保存到磁盘.

Calling btnRestructClick correctly restructures the table removing Field2 and DestTable can be saved to disk with the correct structure and contents.

这篇关于BDE dbidorestructure返回空表的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!

08-28 16:38