📄 main.pas
字号:
{$A+,B-,C-,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q+,R+,S+,T-,U-,V+,W-,X+,Y-,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE GUI}
// User interface to the Restruct unit that contains all the procedures
// necessary to change Paradox table version, block size, and strict
// integrity constraints. To use the procedures in your program, simply
// use the .PAS or .DCU file in your project.
// A detailed explanation of this program is in the Restruct.Pas file.
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DB, DBTables, StdCtrls, BDE, Menus, TblOpen, Priv, Restruct, ExtCtrls;
const
FFalse = 0; FTrue = 1;
V3 = 0; V4 = 1; V5 = 2; V7 = 3;
BS1024 = 0; BS2048 = 1; BS4096 = 2; BS16384 = 3; BS32768 = 4;
type
TMainForm = class(TForm)
RestTbl: TTable;
MainMenu1: TMainMenu;
File1: TMenuItem;
OpenTable1: TMenuItem;
CloseTable1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Options1: TMenuItem;
PrivateDirectory1: TMenuItem;
Restructure1: TMenuItem;
RefreshTableSettings1: TMenuItem;
N2: TMenuItem;
Panel1: TPanel;
Label3: TLabel;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
VLbl: TLabel;
BSLbl: TLabel;
SILbl: TLabel;
GroupBox2: TGroupBox;
Label5: TLabel;
Label6: TLabel;
Label8: TLabel;
SICombo: TComboBox;
VCombo: TComboBox;
BSCombo: TComboBox;
SizeLbl: TLabel;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure VComboChange(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure CloseTable1Click(Sender: TObject);
procedure Restructure1Click(Sender: TObject);
procedure OpenTable1Click(Sender: TObject);
procedure EnableComboBoxes(Enable: boolean);
procedure RefreshTableSettings1Click(Sender: TObject);
procedure PrivateDirectory1Click(Sender: TObject);
private
{ Private declarations }
CursorProps: CURProps;
V34Block, V57Block, V3SI, V4GreaterSI, Versions: TStringList;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.EnableComboBoxes(Enable: boolean);
var
B: Byte;
begin
for B := 0 to ComponentCount - 1 do
if Components[B] is TComboBox then
begin
TComboBox(Components[B]).Enabled := Enable;
if Enable = False then
TComboBox(Components[B]).ItemIndex := -1;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
V34Block := TStringList.Create;
V57Block := TStringList.Create;
V3SI := TStringList.Create;
V4GreaterSI := TStringList.Create;
Versions := TStringList.Create;
with Versions do
begin
Add('3');
Add('4');
Add('5');
Add('7');
end;
with V34Block do
begin
Add('1024');
Add('2048');
Add('4096');
end;
with V57Block do
begin
Add('1024');
Add('2048');
Add('4096');
Add('16384');
Add('32768');
end;
with V3SI do
Add('FALSE');
with V4GreaterSI do
begin
Add('FALSE');
Add('TRUE');
end;
VLbl.Caption := '';
BSLbl.Caption := '';
SILbl.Caption := '';
SizeLbl.Caption := '';
end;
procedure TMainForm.VComboChange(Sender: TObject);
begin
if (VCombo.Text = '3') or (VCombo.Text = '4') then
BSCombo.Items.Assign(V34Block);
if (VCombo.Text = '5') or (VCombo.Text = '7') then
BSCombo.Items.Assign(V57Block);
case StrToInt(BSLbl.Caption) of
1024: BSCombo.ItemIndex := BS1024;
2048: BSCombo.ItemIndex := BS2048;
4096: BSCombo.ItemIndex := BS4096;
16384: BSCombo.ItemIndex := BS16384;
32768: BSCombo.ItemIndex := BS32768;
end;
if BSCombo.Text = '' then
BSCombo.ItemIndex := BS2048;
if VCombo.Text = '3' then
SICombo.Items.Assign(V3SI)
else
SICombo.Items.Assign(V4GreaterSI);
if (UpperCase(SILbl.Caption) = 'TRUE') and (VCombo.Text <> '3') then
SICombo.ItemIndex := FTrue
else
SICombo.ItemIndex := FFalse;
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
RestTbl.Close;
V34Block.Free;
V57Block.Free;
V3SI.Free;
V4GreaterSI.Free;
Versions.Free;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
VCombo.Text := '';
BSCombo.Text := '';
SICombo.Text := '';
Restructure1.Enabled := False;
RefreshTableSettings1.Enabled := False;
end;
procedure TMainForm.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TMainForm.CloseTable1Click(Sender: TObject);
begin
RestTbl.Close;
Restructure1.Enabled := False;
RefreshTableSettings1.Enabled := False;
EnableComboBoxes(False);
VLbl.Caption := '';
BSLbl.Caption := '';
SILbl.Caption := '';
end;
procedure TMainForm.Restructure1Click(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
try
if VLbl.Caption <> VCombo.Text then
begin
AlterVersion(RestTbl, StrToInt(VCombo.Text));
if UpperCase(SICombo.Text) = 'TRUE' then
AlterStrictIntegrity(RestTbl, True);
end;
if BSLbl.Caption <> BSCombo.Text then
begin
AlterBlockSize(RestTbl, StrToInt(BSCombo.Text));
if UpperCase(SICombo.Text) = 'TRUE' then
AlterStrictIntegrity(RestTbl, True);
end;
if UpperCase(SILbl.Caption) <> UpperCase(SICombo.Text) then
if UpperCase(SICombo.Text) = 'TRUE' then
AlterStrictIntegrity(RestTbl, True)
else
AlterStrictIntegrity(RestTbl, False);
finally
Screen.Cursor := crDefault;
end;
end;
procedure TMainForm.OpenTable1Click(Sender: TObject);
begin
RestTbl.Close;
if TableOpenDlg.ShowModal = mrOk then
begin
try
RestTbl.TableName := TableOpenDlg.FileLb.FileName;
RestTbl.Open;
except
on E:Exception do
begin
RefreshTableSettings1.Enabled := False;
Restructure1.Enabled := False;
ShowMessage(E.Message);
Exit;
end;
end;
Label3.Caption := 'Current Table: ' + LowerCase(TableOpenDlg.FileLb.FileName);
Check(DbiGetCursorProps(RestTbl.Handle, CursorProps));
with CursorProps do
begin
if strcomp(szTableType, szParadox) = 0 then
begin
VLbl.Caption := IntToStr(iTblLevel);
BSLbl.Caption := IntToStr(iBlockSize * 1024);
case iBlockSize of
1: SizeLbl.Caption := '64MB Max';
2: SizeLbl.Caption := '128MB Max';
4: SizeLbl.Caption := '256MB Max';
16: SizeLbl.Caption := '1GB Max';
32: SizeLbl.Caption := '4GB Max';
end;
if bStrictRefInt = True then
SILbl.Caption := 'True'
else
SILbl.Caption := 'False';
// Copy data over to "New table settings"
BSCombo.Text := BSLbl.Caption;
case iTblLevel of
3: VCombo.ItemIndex := V3;
4: VCombo.ItemIndex := V4;
5: VCombo.ItemIndex := V5;
7: VCombo.ItemIndex := V7;
end;
if bStrictRefInt = True then
SICombo.ItemIndex := FTrue
else
SICombo.ItemIndex := FFalse;
if (VCombo.Text = '3') or (VCombo.Text = '4') then
BSCombo.Items.Assign(V34Block);
if (VCombo.Text = '5') or (VCombo.Text = '7') then
BSCombo.Items.Assign(V57Block);
case StrToInt(BSLbl.Caption) of
1024: BSCombo.ItemIndex := BS1024;
2048: BSCombo.ItemIndex := BS2048;
4096: BSCombo.ItemIndex := BS4096;
16384: BSCombo.ItemIndex := BS16384;
32768: BSCombo.ItemIndex := BS32768;
end;
if VCombo.Text = '3' then
SICombo.Items.Assign(V3SI)
else
SICombo.Items.Assign(V4GreaterSI);
if UpperCase(SILbl.Caption) = 'TRUE' then
SICombo.ItemIndex := FTrue
else
SICombo.ItemIndex := FFalse;
Restructure1.Enabled := True;
RefreshTableSettings1.Enabled := True;
EnableComboBoxes(True);
end
else
begin
VLbl.Caption := 'N/A';
BSLbl.Caption := 'N/A';
SizeLbl.Caption := '';
SILbl.Caption := 'N/A';
Restructure1.Enabled := False;
RefreshTableSettings1.Enabled := False;
EnableComboBoxes(False);
end;
end;
end;
end;
procedure TMainForm.RefreshTableSettings1Click(Sender: TObject);
begin
Check(DbiGetCursorProps(RestTbl.Handle, CursorProps));
with CursorProps do
begin
VLbl.Caption := IntToStr(iTblLevel);
BSLbl.Caption := IntToStr(iBlockSize * 1024);
case iBlockSize of
1: SizeLbl.Caption := '64MB Max';
2: SizeLbl.Caption := '128MB Max';
4: SizeLbl.Caption := '256MB Max';
16: SizeLbl.Caption := '1GB Max';
32: SizeLbl.Caption := '4GB Max';
end;
if bStrictRefInt = True then
SILbl.Caption := 'True'
else
SILbl.Caption := 'False';
end;
end;
procedure TMainForm.PrivateDirectory1Click(Sender: TObject);
begin
if PrivateDirForm.ShowModal = mrOk then
session.PrivateDir := PrivateDirForm.PrivDirEd.Text;
end;
initialization
Application.Title := 'Paradox Table Utility';
session.open;
finalization
session.close;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -