quarta-feira, 25 de novembro de 2009

Como adicionar campos fisicamente em uma tabela paradox via programação

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, DBGrids, Db, DBTables, BDE, DBCtrls, Menus, ComCtrls,
Buttons ;

type
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Button1: TButton;
Table1: TTable;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

type
ChangeRec = packed record
szName: DBINAME;
iType: Word;
iSubType: Word;
iLength: Word;
iPrecision: Byte;
end;

var
MyChangeRec: ChangeRec;

procedure AddField(Table: TTable; NewField: ChangeRec);

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
MyChangeRec.szName := ‘NovoCampo’;
MyChangeRec.iType := fldPDXCHAR;
MyChangeRec.iSubType:=0;
MyChangeRec.iLength := 45;
MyChangeRec.iPrecision := 0;

Table1.Close;
Table1.Exclusive := True;
Table1.Open;
AddField(Table1, MyChangeRec);
Table1.Close;
Table1.Exclusive := False;
Table1.Open;
end;

procedure AddField(Table: TTable; NewField: ChangeRec);
var
Props: CURProps;
hDb: hDBIDb;
TableDesc: CRTblDesc;
pFlds: pFLDDesc;
pOp: pCROpType;
B: byte;

begin
if Table.Active = False then
raise EDatabaseError.Create(‘A tabela precisa estar aberta’);
if Table.Exclusive = False then
raise EDatabaseError.Create(‘A tabela precisa estar aberta em modo Exclusivo’);
Check(DbiSetProp(hDBIObj(Table.Handle), curxltMODE, integer(xltNONE)));
Check(DbiGetCursorProps(Table.Handle, Props));
pFlds := AllocMem((Table.FieldCount + 1) * sizeof(FLDDesc));
FillChar(pFlds^, (Table.FieldCount + 1) * sizeof(FLDDesc), 0);
Check(DbiGetFieldDescs(Table.handle, pFlds));

for B := 1 to Table.FieldCount do begin
pFlds^.iFldNum := B;
Inc(pFlds, 1);
end;
try
StrCopy(pFlds^.szName, NewField.szName);
pFlds^.iFldType := NewField.iType;
pFlds^.iSubType := NewField.iSubType;
pFlds^.iUnits1 := NewField.iLength;
pFlds^.iUnits2 := NewField.iPrecision;
pFlds^.iFldNum := Table.FieldCount + 1;
finally
Dec(pFlds, Table.FieldCount);
end;
pOp := AllocMem((Table.FieldCount + 1) * sizeof(CROpType));
Inc(pOp, Table.FieldCount);
pOp^ := crADD;
Dec(pOp, Table.FieldCount);
// Blank out the structure...
FillChar(TableDesc, sizeof(TableDesc), 0);
// Get the database handle from the table’s cursor handle...
Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
// Put the table name in the table descriptor...
StrPCopy(TableDesc.szTblName, Table.TableName);
// Put the table type in the table descriptor...
StrPCopy(TableDesc.szTblType, Props.szTableType);
// Close the table so the restructure can complete...
TableDesc.iFldCount := Table.FieldCount + 1;
Tabledesc.pfldDesc := pFlds;
TableDesc.pecrFldOp := pOp;
Table.Close;
// Call DbiDoRestructure...
try
Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, FALSE));
finally
FreeMem(pFlds);
FreeMem(pOp);
Table.Open;
end;
end;
{ ******* Tipos dos campos a ser declarado no iType, *********
******* Veja exemplo ... MyChangeRec.iType := fldPDXCHAR *********
Tipos fisicos do Paradox Tipos fisicos do dBase e FoxPro

fldPDXCHAR fldDBCHAR
fldPDXNUM fldDBNUM
fldPDXMONEY fldDBMEMO
fldPDXDATE fldDBBOOL
fldPDXSHORT fldDBDATE
fldPDXMEMO fldDBFLOAT
fldPDXBINARYBLOB fldDBLOCK (dBASE only)
fldPDXFMTMEMO fldDBBINARY (dBASE only)
fldPDXOLEBLOB fldDBOLEBLOB
fldPDXGRAPHIC fldDBBYTES
fldPDXBLOB fldDBLONG (dBASE 7.0 table format only)
fldPDXLONG fldDBDATETIME (dBASE 7.0 table format only)
fldPDXTIME fldDBDOUBLE (dBASE 7.0 table format only)
fldPDXDATETIME fldDBAUTINC (dBASE 7.0 table format only)
fldPDXBOOL
fldPDXAUTOINC
fldPDXBYTES
fldPDXBCD
}
end.

Nenhum comentário:

Postar um comentário