BDE dbidorestructure returns empty table

Question

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 ?

EDIT

To reproduce the problem :

Create a new VCL forms application
Put a TTable component named T and link it to an existing Paradox table
Put a TDataSource and a TDBGrid linked with table T
In the fields editor load all fields
Modify/add/drop some of them
In the onFormCreate event run the above routine and you will get the restructured table with all fields of all records without value (empty)

EDIT 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;

I can't immediately see anywhere in your code that you actually add or drop any specific fields from a table. To get help with a question like this you need to provide a complete [MCVE](https://stackoverflow.com/help/mcve). — MartynA, Mar 21 '21 at 20:39
The loop ```for i := 1 to CProps.iFields do ..``` adds all fields of the disk-table that are also defined in new configuration except those that are not defined. ```j := oldFieldFound``` returns -1 if the disk-field is ommited in the new configuration. ```for i := 0 to T.Fields.Count-1 do``` adds any field of new configuration that doesn't exist in disk-table (```if not newFieldFound(T.fields[i].FieldName) ```). After this I have a new field descriptor with all fiels I need. Believe the code works ok but I receive a Table with the proper structure with all records containing empty fields. — jim, Mar 22 '21 at 00:37
Please do not add information in comments. Instead, [edit] your question to add it there, where it can be seen. You've also not provided a [mre] that demonstrates the issue as has been requested. Without seeing your code in that [mre], we can't possibly help. — Ken White, Mar 22 '21 at 02:20
Roughly how many tables does your project have, and how many records in them? — MartynA, Mar 23 '21 at 18:42

MartynA · Accepted Answer · 2021-03-24T17:28:53.237

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.

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.

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.

I then add this 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;

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

I then add

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 correctly restructures the table removing Field2 and DestTable can be saved to disk with the correct structure and contents.

Thanks for your help. "Invalid pointer function" is caused by incorrect indexing (i must be j). Please see the modified version. The variables you added are declared out of procedure. Sorry for my silly mistakes. Even after the correction, however, the problem remains — jim, Mar 23 '21 at 13:29
Three things: Firstly, despite what it claims, the code in the DElphiGroups article in your q exhibits the exact same problem ask you're asking about, i.e. all the fields in all the records are blank, because all the field values are Null. Secondly, please add to your q the exact code you use to add a field before you restructure the table. Thirdly, in your `RestructureTable`, hDB is always Nil! — MartynA, Mar 23 '21 at 18:41
Fourthly, I don't think you are accessing some of the dbi structures correctly. Notice that the DelphiGroups article uses pointer casts, as in ` PChar(pOpType) := PChar(pOpType) - (CProps.iFields) * sizeof(CROpType)`, recognising the fact that it's dealing with pointers not numeric variables, which your adaptation of it does not. — MartynA, Mar 23 '21 at 19:37
MartynA, thank you again for your effort. Your code works, not just for one field but for many. My goal is to create a unit that I and others can use in any application that uses paradox tables for restructuring at runtime. So it is desirable to have the ability to add / modify / pack / reindex in addition to deleting fields as my code tries. I will study your code to find out why my code works well when I keep all the fields without adding new ones but when I omit or add a field, it returns the table with the correct structure but with empty fields. — jim, Mar 25 '21 at 14:16
So far I have spent many hours inspecting the indicators and their data having seen that they work as expected, but obviusly as your code shows, the problem is in the use of indicators. I will keep trying — jim, Mar 25 '21 at 14:16
What do you mean by "indicators" and what will you keep trying? Doesn't my answer now answer what you asked, i.e. how to do a resructure which drops a field? — MartynA, Mar 25 '21 at 14:25
"So it is desirable to have the ability to add / modify / pack / reindex..." In that case I think you should close this q (e.g by accepting my answer) and submit several more, one per function that you wish to implement. SO is supposed to be about ** specific** programming points, but what you seem to one is far broader than can properly be covered in a single Q&A. — MartynA, Mar 25 '21 at 14:38
Field Update v1.1, by Nathaniel Woolls, can add/modify one field at a time but I want to achieve more than that (eg. more fields at a time and more functions, like delete etc). So I make the posted code wich does not work completely. Restructers correctly the table but, for some reason that I can't find, returns empty fields. That's why I need help. I will accept your answer as it can achive a part of my goal but, as I said I'll keep trying to find the error in my code. PS. with "indicators" I meant "pointers" (english aren't my language). Tank you again for your help — jim, Mar 25 '21 at 16:32
Thanks. I'll be back with a suggestion about how to deal with other operations but meanwhile where is the function`FieldTypeToBDEFieldInt` declared. I can't find it in my Delphi Sydney installed. — MartynA, Mar 25 '21 at 18:33
function FieldTypeToBDEFieldInt is declaired in Field Update v1.1, by Nathaniel Woolls. I added the code to the question — jim, Mar 26 '21 at 05:15
Thanks for adding the `FieldTypeToBDEFieldInt ` function. The fact that I managed to get single-field deletions has made me interested in trying to add fields as a next step. I'm a bit busy this weekend but I'll be back on Monday (if not sooner) to say how I'm getting on. — MartynA, Mar 26 '21 at 08:43
Well, I've managed to get adding fields working so that the previous fields are correctly displayed in the DBGrid. So, if you are interested, I suggest you post a new q asking how to avoid the DBGrid displaying empty when adding fiekds doing `dbiDoRestructure`. — MartynA, Mar 29 '21 at 07:41

BDE dbidorestructure returns empty table

1 Answers1

Linked