⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 How to restruct paradox DB when you encounter pb whith indexes. You have to use this mecanism to re
💻 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 + -