packform.pas

功能全面的商业财会系统源码,清晰,很有参考价值.扩展性强.

unit PackForm;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls, Grids, DBGrids, DB, DBTables, ComCtrls, Dialogs, BDE;

type
  TfrmPack = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    ProgressBar1: TProgressBar;
    Table1: TTable;
    lblHeading: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
  private
    { Private declarations }
    procedure PackTable(Tbl: TTable);
  public
    { Public declarations }
  end;

var
  frmPack: TfrmPack;

implementation

uses BS1Form, LookUpsData;

{$R *.DFM}

procedure TfrmPack.PackTable(Tbl: TTable);
var
  hDb: hDbiDb;
  TblDesc: CRTblDesc;
  Dir: String;
begin
  Screen.cursor := crHourglass;
  Tbl.close;
  Tbl.exclusive := true;
  Tbl.open;

  SetLength(Dir, dbiMaxNameLen + 1);   //Set string Dir to appropriate size.
  Check(DbiGetDirectory(Tbl.DBHandle, False, PChar(Dir)));   //Put current working directory in string Dir.
  SetLength(Dir, StrLen(PChar(Dir)));   //Resize string Dir to length used.

  FillChar(TblDesc, sizeof(CRTblDesc), #0);   //Fill TblDesc with character #0 as per the size of type CRTblDesc.
  Tbl.Close;
  Check(DbiOpenDatabase(nil, nil, dbiReadWrite, dbiOpenExcl, nil, 0, nil, nil, hDb));   //Open a database in the current session: get handle hDb.
  Check(DbiSetDirectory(hDb, PChar(Dir)));   //Set current directory to Dir.

  StrPCopy(TblDesc.szTblName, Tbl.TableName);   //Set TblDesc parameters.
  StrCopy(TblDesc.szTblType, szParadox);
  TblDesc.bPack := TRUE;
  Check(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, False));   //Pack the table.
  Tbl.close;
  ProgressBar1.StepIt;
end;

procedure TfrmPack.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmPack.FormCreate(Sender: TObject);
begin
  Table1.DatabaseName := strDatabaseName;
end;

procedure TfrmPack.btnOKClick(Sender: TObject);
var
  I: integer;
begin
  try   //Ensure no other users are using the system.
    frmBS1.tblCompany.close;
    frmBS1.tblCompany.exclusive := true;
    frmBS1.tblCompany.open;
    frmBS1.tblCompany.close;
    frmBS1.tblCompany.exclusive := false;
  except
    frmBS1.tblCompany.exclusive := false;
    frmBS1.tblCompany.open;
    raise(exception.create('No one else can be using ' + application.title));
  end;

  for I := 0 to Application.ComponentCount - 1 do begin
    if (Application.Components[I] is TForm)
      and (TForm(Application.Components[I]).name <> 'frmBS1')
      and (TForm(Application.Components[I]).name <> 'frmPack')
      and (TForm(Application.Components[I]).visible = true) then raise(exception.create('All forms must be closed before running this option'));   //Get user to finish and "close" (or hide) all forms.
    if (Application.Components[I] is TForm)
      and (TForm(Application.Components[I]).name <> 'frmBS1')
      and (TForm(Application.Components[I]).name <> 'frmPack')
      and (TForm(Application.Components[I]).name <> 'frmCalendar')
      and (TForm(Application.Components[I]).name <> 'frmDialer')
      and (TForm(Application.Components[I]).name <> 'frmPreview')
      and (TForm(Application.Components[I]).name <> 'dmLookUps') then TForm(Application.Components[I]).release;   //Close any open forms.
  end;
  session.databases[0].CloseDatasets;   //Close any remaining open tables.

  repaint;
  Screen.cursor := crHourglass;
  ProgressBar1.max := 41;
  ProgressBar1.step := 1;
  ProgressBar1.StepIt;
  try
    Table1.TableName := 'JVDet.db'; PackTable(Table1);
    Table1.TableName := 'JV.db'; PackTable(Table1);
    Table1.TableName := 'JVCtl.db'; PackTable(Table1);
    Table1.TableName := 'APInvChq.db'; PackTable(Table1);
    Table1.TableName := 'APInvDet.db'; PackTable(Table1);
    Table1.TableName := 'APInv.db'; PackTable(Table1);
    Table1.TableName := 'APInvCtl.db'; PackTable(Table1);
    Table1.TableName := 'APCheq.db'; PackTable(Table1);
    Table1.TableName := 'APChqCtl.db'; PackTable(Table1);
    Table1.TableName := 'ARInvPmt.db'; PackTable(Table1);
    Table1.TableName := 'ARInvDet.db'; PackTable(Table1);
    Table1.TableName := 'ARInv.db'; PackTable(Table1);
    Table1.TableName := 'ARInvCtl.db'; PackTable(Table1);
    Table1.TableName := 'ARPmt.db'; PackTable(Table1);
    Table1.TableName := 'ARPmtCtl.db'; PackTable(Table1);
    Table1.TableName := 'VBalance.db'; PackTable(Table1);
    Table1.TableName := 'VContact.db'; PackTable(Table1);
    Table1.TableName := 'Vendor.db'; PackTable(Table1);
    Table1.TableName := 'VendCtl.db'; PackTable(Table1);
    Table1.TableName := 'CBalance.db'; PackTable(Table1);
    Table1.TableName := 'CContact.db'; PackTable(Table1);
    Table1.TableName := 'Customer.db'; PackTable(Table1);
    Table1.TableName := 'CustCtl.db'; PackTable(Table1);
    Table1.TableName := 'Salesman.db'; PackTable(Table1);
    Table1.TableName := 'CusType.db'; PackTable(Table1);
    Table1.TableName := 'Bank.db'; PackTable(Table1);
    Table1.TableName := 'Company.db'; PackTable(Table1);
    Table1.TableName := 'Currency.db'; PackTable(Table1);
    Table1.TableName := 'Item.db'; PackTable(Table1);
    Table1.TableName := 'ItemCtl.db'; PackTable(Table1);
    Table1.TableName := 'Tax.db'; PackTable(Table1);
    Table1.TableName := 'GLActual.db'; PackTable(Table1);
    Table1.TableName := 'GLBudget.db'; PackTable(Table1);
    Table1.TableName := 'GLHist.db'; PackTable(Table1);
    Table1.TableName := 'GLAccnt.db'; PackTable(Table1);
    Table1.TableName := 'FStmtLAc.db'; PackTable(Table1);
    Table1.TableName := 'FStmtLTo.db'; PackTable(Table1);
    Table1.TableName := 'FStmtLin.db'; PackTable(Table1);
    Table1.TableName := 'FStmt.db'; PackTable(Table1);
    Table1.TableName := 'FStmtCtl.db'; PackTable(Table1);
  finally
    Screen.cursor := crDefault;
    frmBS1.tblCompany.open;   //Re-open table(s) on frmBS1.
    dmLookUps.free; application.createform (TdmLookUps,dmLookUps);   //Re-open tables on data module.
  end;
end;

end.