Kod: Tümünü seç
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Db, DBTables,Bde,Dbitypes;
type
TPackForm = class(TForm)
Button1: TButton;
Table1: TTable;
Edit1: TEdit;
Label1: TLabel;
OpenDialog1: TOpenDialog;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
PackForm: TPackForm;
implementation
{$R *.DFM}
procedure PackTable(Table: TTable);
var
Props: CURProps;
hDb : hDBIDb;
TableDesc: CRTblDesc;
begin
// Make sure the table is open exclusively so we can get the db handle...
if not Table.Active then
raise EDatabaseError.Create('Pack için dosyanın açık olması gerekiyor');
if not Table.Exclusive then
raise EDatabaseError.Create('Pack için dosyanın Exclusive modunda olması gerekiyor');
// Get the table properties to determine table type...
Check(DbiGetCursorProps(Table.Handle, Props));
// If the table is a Paradox table, you must call DbiDoRestructure...
// 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);
// Set the Pack option in the table descriptor to TRUE...
TableDesc.bPack := True;
// Close the table so the restructure can complete...
Table.Close;
// Call DbiDoRestructure...
Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False));
Table.Open;
end;
procedure TPackForm.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Edit1.Text := OpenDialog1.FileName;
end;
procedure TPackForm.Button2Click(Sender: TObject);
begin
If Table1.Active=True Then Table1.Close;
Table1.TableName := Edit1.Text;
Table1.Exclusive := True;
Table1.Open;
PackTable(Table1);
ShowMessage('Pack işlemi bitti');
end;
procedure TPackForm.Button3Click(Sender: TObject);
begin
If Table1.Active=True Then Table1.Close;
Table1.TableName := Edit1.Text;
Table1.Exclusive := True;
Table1.Open;
Dbiregenindexes(Table1.Handle);
Showmessage('Reindex bitti abi');
end;
procedure TPackForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
If Table1.Active=True Then Table1.Close;
end;
procedure TPackForm.Button4Click(Sender: TObject);
begin
close;
end;
end.
Makaleler bölümüne taşındı.