Agregar un campo a una tabla paradox (runtime)

[[sitrico]]

Saludos a todos.

Tengo una aplicación que utiliza BDD Paradox y por supuesto se me olvidó agregar un simple campo en una de las bases de datos, ya que no puedo ir de equipo en equipo cambiando la estructura, necesito agragarle al programa la capacidad de comprobar la existencia de un campo y si no existe que lo agregue en tiempo de ejecución. Para eso agregué el siguiente código (tomado de: http://www.experts-exchange.com/Comp..._20664695.html )

Var
db:TTable;

Begin
db := tTable.Create(nil);
db.DatabaseName := dbTipo06.DatabaseName;
db.TableName := dbTipo06.TableName;
db.open;
If db.FindField('NombreCampoOlvidado') = nil Then
Begin
db.close;
AddField(db,'NombreCampoOlvidado',6,0,4); // Campo Integer
End;
db.Free;
End;

y el procedimiento AddField:

unit AddFields;

interface

Uses DBTables, Bde, SysUtils;

{ Definiciones de tipo y subtipo
String: 1,0
Time: 10,0
TimeStamp: 11,0
Date: 2,0
Memo: 3,22
Binary: 3,23
Formatted Memo: 3,24
OLE: 3,25
Graphics: 3,26
Boolean: 4,0
Small Integer: 5,0
Integer: 6,0
AutoInc: 6,29
Float: 7,0
Currency: 7,21
BCD: 8,0
Byte: 9,0
}

procedure AddField(Table : TTable; FldName : String;FldType, FldSubType,FldSize:Integer);

implementation

procedure AddField(Table : TTable; FldName : String;FldType, FldSubType,FldSize:Integer);
type
FLDDescs = array [1..100] of FLDDesc; // these are kludges for ease of addressing
PFLDDescs = ^FLDDescs;
CROpTypes = array [1..100] of CROpType;
PCROpTypes = ^CROpTypes;
var
Props: CURProps;
hDb: hDBIDb;
TableDesc: CRTblDesc;
pFields: pFLDDescs;
pOp: pCROpTypes;
i:Integer;
begin
// Make sure table is opened exclusively
If (Table.Active and Not Table.Exclusive) Then Table.Close;
If (Not Table.Exclusive) Then Table.Exclusive := True;
If (Not Table.Active) Then Table.Open;
try
Check(DbiGetCursorProps(Table.Handle, Props));
pFields := AllocMem((props.iFields+1) * sizeof(FLDDesc));
pOp := AllocMem((props.iFields+1) * sizeof(CROpType));
Check(DbiGetFieldDescs(table.Handle,@PFields[1]));
for i := 1 to props.iFields do // retain existing fields
pop^[i] := crNOOP;
i := props.iFields + 1;
pOp^[i] := crADD;
with PFields^[i] do
begin
StrCopy(szName,PChar(FldName));
iFldType := FldType;
ISubType := FldSubType;
IUnits1 := FldSize;
end;
FillChar(tabledesc,sizeof(CRTblDesc),#0);
with tabledesc do
begin
StrPCopy(szTblName,Table.TableName);
StrCopy(szTblType,szParadox);
bPack := True;
iFldCount := props.iFields+1;
pecrFldOp := @pop^[1];
pfldDesc := @pfields^[1];
end;
Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
Table.Close;// table must be closed as restructure requires exclusive access
Check(DbiDoRestructure(hdb,1,@tabledesc,nil,nil,nil,False));
finally
FreeMem(PFields);
FreeMem(pOp);
end;
end;


end.

Todo bien en teoría, pero no funciona porque me genera una excepción: "Invalid handle to the functión". Lo mismo me sucedió con varios métodos "AddField" que usan una tecnica similar (incluyendo uno tomado directamente de borland).

¿Alguien sabe porque ocurre este error y como solucionarlo?

PD. Uso Delphi 7.

Gracias una vez más.

[marcoszorrilla]

Porque no pruebas con este código:

Es mucho más simple creo.

procedure TForm1.Button1Click(Sender: TObject);
var
nCont:Integer;
sLista:TStringList;

begin
sLista:=TStringList.Create();
table1.FieldDefs.Update;

  for nCont:=0 to Table1.FieldDefs.Count -1 do
  begin
  sLista.Add(Table1.FieldDefs[nCont].Name);
  end;

  sLista.Sort;

  If sLista.Find('Sueldo',nCont) then
  ShowMessage('El campo ya existe.')
  else
  begin
  Table1.Close;
  Query1.Close;
  Query1.Sql.Clear;
  Query1.Sql.Add('Alter Table ''Albaranes.db'' Add Sueldo Integer');

  Query1.ExecSQL;
  end;


end;

Se necesita un Ttable y un Tquery.

Un Saludo.

[potlanos]

otra forma de hacerlo...

function TFCrea.nuevoCampo(campo: tipoCampo; Tab, sNom: string; Lon: integer):boolean;
var nuevo : boolean;
begin
nuevo := false;
Tabla.TableName := Tab;
try
Tabla.Open;
if tabla.FindField(snom) = nil then
begin
nuevo := true;
tabla.Close;
try
case campo of
tpLogico : q.sql.Strings[0] := 'alter table "' + Tab + '" add ' + sNom + ' boolean';
tpFecha : q.sql.Strings[0] := 'alter table "' + Tab + '" add ' + sNom + ' date';
tpCadena : q.sql.Strings[0] := 'alter table "' + Tab + '" add ' + sNom + ' char(' + inttostr(lon) + ')';
tpEntero : q.sql.Strings[0] := 'alter table "' + Tab + '" add ' + sNom + ' integer';
tpIncermen : q.sql.Strings[0] := 'alter table "' + Tab + '" add ' + sNom + ' autoinc';
tpReal : q.sql.Strings[0] := 'alter table "' + TaB + '" add ' + sNom + ' numeric';
tpmemo : q.sql.Strings[0] := 'alter table "' + TaB + '" add ' + sNom + ' blob(100)';

end;//case

q.ExecSQL;
except
MsgLista('ERROR : Crear Campo: ' + sNom + '/ Tabla: '+Tab);
nuevo := false; //** si hay algun error marcar como no actualizado **
end;
end
else Tabla.Close;

if nuevo then MsgLista('OK : Creado campo: ' + sNom + '/ Tabla: '+Tab);
nuevoCampo := nuevo;
except
MsgLista('ERROR : Crear Campo: ' + sNom + '/ Tabla: '+Tab);
nuevo := false;
end;
end;


procedure TFCrea.MsgLista(mensaje:string);
begin
Lista.Items.Add(mensaje);
Lista.Update;
end;



y para llamar a la funcion

nuevoCampo(tpreal,'tabla.db','campo',0);

Salu2.
P0Tlanos

[[sitrico]]

Gracias a ambos, la solución de SQL es mucho mejor que la PARADOX y no necesita componentes adicionales, de todas maneras publico mi procedimiento para que le sirva a alguien más

Procedure AddFieldSql(Table1:TTable;campo,Tipo:String);

var
nCont:Integer;
sLista:TStringList;
Query1 : TQuery;
s : String;

begin
sLista:=TStringList.Create();
Query1 := TQuery.Create(nil);

Query1.DatabaseName := Table1.DatabaseName;
table1.FieldDefs.Update;

for nCont:=0 to Table1.FieldDefs.Count -1 do
sLista.Add(Table1.FieldDefs[nCont].Name);
sLista.Sort;

If Not(sLista.Find(Campo,nCont)) then
begin
Table1.Close;
Query1.Close;
Query1.Sql.Clear;
s := 'Alter Table '+#39+Table1.TableName+#39+
' Add '+Campo+' '+Tipo;
// Ejemplo: 'Alter Table ''Albaranes.db'' Add Sueldo Integer'
Query1.Sql.Add(s);
Query1.ExecSQL;
end;

Query1.Free;
end;

Aunque me queda la duda de porque no sirve el otro método, al final no importa porque con este simple código se soluciona el problema. :-)

Gracias nuevamente.