compressrepairmdb_u.pas

delphi7.0+SQl server 2000开发的,对于初学者有较好的参考价值

unit CompressRePairMDB_u;

interface

uses
  SysUtils,ComObj,Variants,Dialogs;

function CompressRePairMDB(dbfilename:string;dbpwd:string):Boolean;

implementation

function CompressRePairMDB(dbfilename:string;dbpwd:string):Boolean;
var
  dao:OLEVariant;
  sTempDBname:string;
begin
   result:=true;
   stempdbname:=changefileext(dbfilename,'.tmp');
   if fileExists(stempDBName) then DeleteFile(sTempDBName);
   dao:=CreateOLEObject('DAO.DBEngine.36');
   try
      try
        dao.compactDatabase(dbfilename,sTempDBName,'',0,';pwd='+dbpwd);
        DeleteFile(dbfilename);
        RenameFile(sTempDBName,dbfilename);
      except
         on e:Exception do begin
            result:=False;
            MessageDlg('数据库压缩修复失败！！'+stringofchar(#13,2)+'请关掉所有打开的子窗口,在重试。'+stringofchar(#13,2)+e.Message,mtError,[mbOK],0);
         end;
      end;
   finally
      dao:=Unassigned;
   end;
end;

end.