urebuild_index.pas

企业进销存管理系统

end;

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

procedure TReBuild_Index.FormShow(Sender: TObject);
begin
  StaticText1.Caption:= Copy(StaticText1.Caption,1,19)+ReadWriteReg('ReIndexDate','不能确定',False);;
end;

procedure TReBuild_Index.FormDestroy(Sender: TObject);
begin
  setdmTable(False);
  sTableName.Free;
end;

procedure TReBuild_Index.MutilReBuild(Sender: TObject);
var
  BusyForm: TForm;
  sTableName: TstringList;
  strResult: string;
  i: integer;
  password: string;
begin
  if not BackupDataBase then
    if not R_YesNoMessage(['您没有进行重整前的资料备份或备份动作失败,'#13#13'如果进行资料重整将会导致资料损毁,是否继续进行重整作业?'+#13#13+'建议洽询设计人员。']) then
      exit;

  SystemBusy(BusyForm,True);
  sTableName := TStringList.Create;
  Session.GetTableNames(rDataBaseName,'',false,false,sTableName);

  try
    for i:= 0 to sTableName.Count-1 do
      try
          if (LowerCase(sTableName[i])='password') then
            begin
              With tbIndex do
                begin
                  Close;
                  DataBaseName:=rDataBaseName;
                  TableName:='PassWord';
                  Open;
                end;
               if NOT tbIndex.Active then password := '7805'
               else Password := '';
               tbIndex.Close;
            end
          else
            Password := '';
          memo1.Lines.Add('');
          if DBRebuildTable(DBGetAliasPath(rDataBaseName),sTableName[i]+'.DB',DBGetAliasPath(rDataBaseName)+'clone\'+sTableName[i]+'.DB','','','','',PassWord,strResult) then
            memo1.Lines.Add('资料表 [' + sTableName[i] + '] 修复成功。 ')
          else begin
            memo1.Lines.Add('资料表 [' + sTableName[i] + '] 修复失败,请洽程式设计人员。 '+#10#13+'失败原因:'+strResult+#13#10);
          end;
      except
        on E: EDataBaseError do begin
          BusyForm.Hide;
          memo1.Lines.Add('资料表 [' + sTableName[i] + '] 资料库发生错误,错误讯息 ['
                     + E.Message + '].');
        end;
      end;

      BusyForm.Hide;
      memo1.Lines.Add('已成功的重建整个资料表');
      showmessage('已成功的重建整个资料表');
      DBDeleteTableFileIO(currentPath,'.DB');
  finally
    sTableName.Free;
    SystemBusy(BusyForm,False);
  end;
end;


procedure TReBuild_Index.FormActivate(Sender: TObject);
begin
  sTableName := TStringList.Create;
  Application.OnException := HandleExceptions;
  Screen.Cursor := crHourGlass;
  try
    Session.GetTableNames(rDataBaseName,'',True,False,ComboBox1.Items);
    ComboBox1.Items.Insert(0,'<<所有的资料表>>');
    ComboBox1.ItemIndex := 0;
  Finally
    Screen.Cursor := crDefault;
  end;
  setdmTable(True);

  if not DirectoryExists(DBGetAliasPath(rDataBaseName)+'clone\') then begin
    r_okmessage(['找不到资料表范本,请洽程式设计人员']);
    close;
  end;

end;

procedure TReBuild_Index.FormCreate(Sender: TObject);
begin
  currentPath := ExtractFilePath(Application.ExeName);
  if currentPath[length(currentPath)] <> '\'  then
  currentPath := currentPath + '\';
  Session.OnPassword:=OnNeedPassWord;
end;

procedure TReBuild_Index.StructReBuild(TableName: string);
var
  strTmpClone,strTmpStruct: string;
  AutoIncIsSingleFieldPrimaryKey : Boolean;
  MultiPassOK                    : boolean;
  OrigCloneTable                 : String;
  AlixPath                       : string;
  AutoIncField                   : Integer;
  PassWord: string;
  CloneTable                     : String;
  strError                       : String;
  WorkTableType                  : DBINAME;
  CloneMode                      : TCloneMode;
begin
  if UpperCase(TableName) = 'PASSWORD.DB' then
    PassWord := '7805'
  else
    PassWord := '';
  AlixPath := DBGetAliasPath(rDataBaseName);
  WorkTableType := DBGetTableType(TableName);
  try
    { set up working tables needed for the multi-pass rebuild}
    strTmpClone := '_CLONE.DB';
    strTmpStruct := '_STRUCT.DB';

    { determine whether AutoInc field can be transformed to an Integer field
      and back during the rebuild process. To be a legal transformation, the
      AutoInc field must be the only field in the primary key. }
    AutoIncIsSingleFieldPrimaryKey :=
            DBCheckAutoIncTranslationAllowed(AlixPath, TableName, '');

    MultiPassOK := False;  { assume failure for now }
    try
      OrigCloneTable := AlixPath+'Clone\'+TableName;
      Application.ProcessMessages;

      { Create a clone of the current clone table. This will ensure we have the
        structure of the original table, even if the clone table is the target table
        itself }

      { Create Clone Table without indices and convert AutoInc to LongInt }
      if DBCloneTableStructure(ExtractFilePath(OrigCloneTable), ExtractFileName(OrigCloneTable),
                               AlixPath, strTmpStruct, '', cmNoChange, AutoIncField) then
        if DBCloneTableStructure(AlixPath, strTmpStruct, AlixPath, strTmpClone, '',
                                 cmDropAllIndices, AutoIncField) then
          if (not AutoIncIsSingleFieldPrimaryKey) Or
              DBCloneTableStructure(AlixPath, strTmpClone, AlixPath, strTmpClone, '',
                                    cmChangeAutoIncToInt, AutoIncField) then
          begin
            CloneTable := AlixPath + strTmpClone;
            { PHASE (1) Rebuild without Primary & Secondary Indices and with AutoInc Fields
              changed to Integer }
            if DBRebuildTable(AlixPath, TableName, CloneTable,'','','','',password, strError) then
            begin
              { PHASE (2) Pack table }
              if DBPackTable(AlixPath, TableName, '', WorkTableType, False) then
              begin
                { PHASE (3) Add Primary index and rebuild }
                if DBCloneTableStructure(AlixPath, strTmpStruct, AlixPath, strTmpClone, '',
                                         cmDropSecondary, AutoIncField) then
                  if (not AutoIncIsSingleFieldPrimaryKey) Or
                     DBCloneTableStructure(AlixPath, strTmpClone, AlixPath, strTmpClone, '',
                                           cmChangeAutoIncToInt, AutoIncField) then
                    if DBRebuildTable(AlixPath, TableName, CloneTable,'','','','',Password, strError) then
                    begin
                      { PHASE (4) Add back secondary indexes }
                      if AutoIncIsSingleFieldPrimaryKey then
                        CloneMode := cmChangeAutoIncToInt
                      else
                        CloneMode := cmNoChange;
                      if DBCloneTableStructure(AlixPath, strTmpStruct, AlixPath, strTmpClone, '',
                                               CloneMode, AutoIncField) then
                      begin
                        if DBRebuildTable(AlixPath, TableName, CloneTable,'','','','',PassWord, strError) then
                        begin
                          if AutoIncIsSingleFieldPrimaryKey And (AutoIncField > 0) then
                          begin
                            if DBSetAutoIncField(AlixPath, TableName, '', AutoIncField) then
                              MultiPassOK := True;
                          end
                          else
                            MultiPassOK := True;
                        end;
                      end;
                    end;

              end;
            end;
          end;
    finally
      { delete clone tables }
      DBDeleteTableFileIO(ExtractFilePath(CloneTable), ExtractFileName(CloneTable));
      DBDeleteTableFileIO(AlixPath, strTmpStruct);
      if MultiPassOK then
        memo1.lines.add('Table [' + TableName + '] rebuilt.')
      else
        memo1.lines.add('FAILED to rebuild table [' + TableName + '] : Error = [' + strError + '].');
    end;
  except
    on E: EDataBaseError do
    begin
      MessageDlg('FAILED to rebuild table [' + TableName + '] : Database error = [' + E.Message + '].',
                 mtInformation, [mbOK], 0);
    end;
  end;

  { Remove any temporary files }
  if not DBDeleteTableFileIO(ExtractFilePath(Application.ExeName), '.DB') then
    memo1.lines.add('Failed to remove temporary files.');

end;

procedure TReBuild_Index.Button4Click(Sender: TObject);
var
  sTableName: TstringList;
//i: integer;
begin

  if not BackupDataBase then
    if not R_YesNoMessage(['资料库备份失败,如果进行资料重整将会导致资料损毁,是否继续进行重整作业?'+#10#13+'建议洽询设计人员。']) then
      exit;


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

  try
    //for i:= 0 to sTableName.Count-1 do
    //  StructReBuild(sTableName[i]+'.DB');
    StructReBuild('Billdetail.DB');
  finally
    sTableName.Free;
  end;

end;

end.