urebuild_index.pas

企业进销存管理系统

unit uReBuild_Index;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,BDE,DB,Wintypes,WinProcs,DBTables,Registry,DBUNIT,BDEUTIL,TUTIL,FileCtrl;

type
  TReBuild_Index = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    StaticText1: TStaticText;
    tbIndex: TTable;
    ComboBox1: TComboBox;
    Label3: TLabel;
    Memo1: TMemo;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MutilReBuild(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    Procedure OnNeedPassword(Sender: TObject; var Continue: Boolean);
  private
    sTableName: TStringList;//store TableName
    FDataBasename: string;
    function BackupDataBase: boolean;
    procedure SetDMTable(Option: boolean);
    procedure StructReBuild(TableName: string);
    { Private declarations }
  public
    { Public declarations }

    procedure HandleExceptions(Sender: TObject; E: Exception);
    procedure WriteMsg(strWrite:string);
    Function RebuildIndexes(strAlias,strTable:string; var strError: string):Boolean;
    property rDataBaseName: string read FDataBasename write FDataBaseName;
  end;

var
  ReBuild_Index: TReBuild_Index;

implementation

uses utilities,uDM
{$ifndef NoDataBase}
   //,uDM
{$endif}
    ;

{$R *.DFM}

var
  currentPath: string;

function TReBuild_Index.BackupDataBase: boolean;
var
  directory,stemp: string;
  i: integer;
  sTableName: TstringList;
  BusyForm: TForm;
begin
  result := false;
  if not R_YesNoMessage(['系统将先执行备份作业,以便进行资料整理工作,要进行重整前的资料备份吗?']) then
    exit;
  SystemBusy(BusyForm,True);

  try
    directory := currentPath+'重整备份'+FormatDateTime('eemmdd',now);
    i := 1;
    stemp := directory;
    directory := stemp + '001';
    while  DirectoryExists(directory) do begin
      inc(i);
      directory := stemp+IntToString(i,3);
    end;
    ForceDirectories(directory);

    if DirectoryExists(directory) then begin

      sTableName := TStringList.Create;
      Session.GetTableNames(rDataBaseName,'',false,false,sTableName);
      try

        for i:= 0 to sTableName.Count-1 do
          if not DBCopyTableFileIO(DBGetAliasPath(rDataBaseName),sTableName[i],directory,sTableName[i]) then begin
            showmessage('备份资料库时发生错误');
            result := false;
            break;
          end;
        Result := true;
      finally
        sTableName.Free;
      end;

    end
    else
      showmessage('磁碟发生错误,不能建立备份路径');
  finally
    SystemBusy(BusyForm,False);
  end;
end;

Procedure TReBuild_Index.OnNeedPassword(Sender: TObject; var Continue: Boolean);
begin
  Continue:=True;
end;

procedure TReBuild_Index.HandleExceptions(Sender: TObject; E: Exception);
begin
  if E.Message <> '' then
  begin
    Screen.Cursor := crDefault;
    MessageDlg(E.Message,mtError,[mbOK],0);
  end;
end;

procedure TReBuild_Index.WriteMsg(strWrite:string);
begin
  Memo1.Lines.Add(strWrite);
  Memo1.Update;
end;

Function TReBuild_Index.RebuildIndexes(strAlias,strTable:string; var strError: string):Boolean;
var
  bdeResult : DBIResult;
begin
  Result := False;
  if tbIndex.Active then tbIndex.Active := False;
  tbIndex.DatabaseName := strAlias;
  tbIndex.TableName := strTable;
  Screen.Cursor := crHourGlass;
  try
    WriteMsg('正在开启资料表'+strTable+'...');
    tbIndex.Exclusive := True;
    tbIndex.Active:=True;
  Finally
    Screen.Cursor := crDefault;
  end;
  if NOT tbIndex.Active
    then
      strError := '这个资料表无法以专属模式开启,'+#10#13#13+'可能正在被其它使用者使用中!'
    else
      begin
        WriteMsg('正在重建资料表'+strTable+'的索引中...');
        Screen.Cursor := crHourGlass;
        try
          bdeResult := DbiRegenIndexes(tbIndex.Handle);
          case bdeResult of
            DBIERR_NONE : Result := True;
            DBIERR_INVALIDHNDL : strError := '资料表的句柄错误!';
            DBIERR_NEEDEXCLACCESS:  strError := '资料表在被以共享模式开启!';
            DBIERR_NOTSUPPORTED:  strError :=  '远端的索引无法被重建!';
            DBIERR_FILEBUSY:  strError :=  '这个资料表无法以专属模式开启,'+#10#13#13+'可能正在被其它使用者使用中!';
          else
            strError := '这个资料表无法以专属模式开启,'+#10#13#13+'可能正在被其它使用者使用中!';
          end;
        Finally
          Screen.Cursor := crDefault;
        end;
      end;
      if Result then
        begin
          WriteMsg('完成!');
          WriteMsg('');
        end
      else
        begin
          WriteMsg('失败!'+'  '+strError);
          WriteMsg('');
        end;
end;

//设定DataModual的资料表状态
procedure TReBuild_Index.SetDMTable(Option: boolean);
var
  i: integer;
  Index: integer;
begin
{$ifndef NoDataBase}

  if option then //储存资料表是开启的元件,并且关闭
    with DM do begin
      sTableName.Clear;
      for i:= 0 to ComponentCount-1 do
        if (Components[i] is TDataSet)then
          if (Components[i] as TDataSet).active then begin
            sTableName.Add(Components[i].Name);
            (Components[i] as TDataSet).Close;
          end;
    end
  else begin //资料重整完後,将DM入的资料表重新开启
    with DM do begin
      sTableName.Sort;
      for i:= 0 to ComponentCount-1 do
        if (Components[i] is TDataSet)then
          if sTableName.Find(Components[i].Name,Index) then
            (Components[i] as TDataSet).Open;
    end
  end;
{$endif}
end;

procedure TReBuild_Index.Button1Click(Sender: TObject);
var
  I : integer;
  strError :string;
  Fail : Boolean;
begin
  Memo1.ScrollBars:=ssBoth;
  strError :='';
  Fail := False;
  ReadWritereg('ReIndexDate',DatetoStr(Now),True);
  if ComboBox1.ItemIndex>0 then
    begin
      if NOT RebuildIndexes(rDataBaseName,Combobox1.Items[ComboBox1.ItemIndex],strError) then
          begin
            MessageDlg('不能为资料表'+Combobox1.Items[ComboBox1.ItemIndex]+'重建索引档.'+#10+#10+'原因:'+strError,mtError,[mbOK],0);
            Fail :=True;
          end;
      if NOT Fail then
        MessageDlg('已经成功地为资料表'+Combobox1.Items[ComboBox1.ItemIndex]+'重建了索引档!',mtInformation,[mbOK],0);
    end
  else
    begin
      for i := 1 to Combobox1.Items.Count-1 do
        if NOT RebuildIndexes(rDataBaseName,Combobox1.Items[i],strError) then
          begin
            MessageDlg('不能为资料表'+Combobox1.Items[i]+'重建索引档.'+#10+#10+'原因:'+strError,mtError,[mbOK],0);
            Fail :=True;
          end;
     if NOT Fail then
       begin
         MessageDlg('已经成功地为所有的资料表重建了索引档!',mtInformation,[mbOK],0);
         //Close;
       end;
    end;
  StaticText1.Caption:= Copy(StaticText1.Caption,1,19) + DateToStr(Now);