在线等待！！DAO方式压缩ACCESS数据库！快！！！

Question

包括引用单元，及例子！！！！ 谢谢了！！！！

Answer 1

动态创建、压缩Access数据库(*.MDB)     声明：这是前无古人，后无来者的解决方案(有点吹，但是我实在太激动了！)，希望各位能多多关照
创建Access数据库几乎是所有Delphi+Access所遇到的难题，我经过两头(昨天上午到现在)的艰苦奋战，终于将它全部解开，现在一一奉献给大家：一、通过OLE方式创建
    相信各位都用通过OLE方式访问Word、Excel文件的经历，具体我不说太多，直接把具体代码写出来就完了
    在引用部分加入：
    uses ComObj;
    实现部分：
    procedure TFormOffice.BitBtn1Click(Sender: TObject);
    var
      CreateAccess:OleVariant;
    begin
      CreateAccess:=CreateOleObject('ADOX.Catalog');
      CreateAccess.Create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\Aceco.mdb');
    end;    说明：
      1、在C:\下创建Aceco.mdb；
      2、是Access2000格式，用Access97打不开；
      3、系统需安装MDAC，这是好消息，客户不需安装Access也可以二、通过DBEngine创建
    这才是关键中的关键，是我一定要写出来的原因！
    各位是否还记得安装Delphi的时候，如果你选择自定义安装(我一般用Delphi写控件，所以当然是越小越好)，会有很多安装选项，让你选择Access97或Access2000，还有MDAC等，问题就在这里！Delphi5.0中早就封装了现成的类，只是大家都没有注意而已它位于：
    $Delphi5\Imports
    目录下！
    其中有DAO97.DCU文件，它是通过DAO350.DLL来完成的，其中的定义部分和DAO350.DLL如出一辙！OK，到现在，所有的一切都明白了(可惜我花了一天时间！)。那么具体实现起来就太方便了，具体过程如下：
    在引用部分加入：
    uses DAO97;
    实现部分：
    procedure TFormOffice.BitBtn4Click(Sender: TObject);
    var
      Engine:DBEngine;
    begin
      Engine:=CoDBEngine.Create;
      Engine.CreateDatabase('c:\NewAccess.mdb',';LANGID=0x0804;CP=936;COUNTRY=0;',dbEncrypt);
    end;    说明：
        1、在C:\下创建NewAccess.mdb；
        2、语言国家是简体中文；
        3、压缩整理数据库用Engine.CompactDatabase('c:\invoice.mdb','c:\God.mdb','',0,'');就是将c:\invoice.mdb压缩整理成c:\God.mdb，剩下的只是将c:\invoice.mdb删除(DeleteFile('c:\invoice.mdb');)，然后将c:\God.mdb重新命名(RenameFile('c:\God.mdb','c:\invoice.mdb');)即可。三、通过Access97创建，然后拷贝
四、通过ODBC的API函数创建补充：
    1、通过OLE方式创建时如果是Access97，那么可能是CreateAccess.Create('Provider=Microsoft.Jet.OLEDB.3.5.1;Data Source=c:\Aceco.mdb');，嘿嘿，小弟对VB实在是一窍不通，还望各位再测试一下(可以需要MDAC比较低的版本)。
    2、关于CreateDatabase中国家的设置：
       Module LanguageConstants; // DAO predefined constants.
        dbLangArabic = ;LANGID=0x0401;CP=1256;COUNTRY=0;
        dbLangCzech = ;LANGID=0x0405;CP=1250;COUNTRY=0;
        dbLangDutch = ;LANGID=0x0413;CP=1252;COUNTRY=0;
        dbLangGeneral = ;LANGID=0x0409;CP=1252;COUNTRY=0;
        dbLangGreek = ;LANGID=0x0408;CP=1253;COUNTRY=0;
        dbLangHebrew = ;LANGID=0x040D;CP=1255;COUNTRY=0;
        dbLangHungarian = ;LANGID=0x040E;CP=1250;COUNTRY=0;
        dbLangIcelandic = ;LANGID=0x040F;CP=1252;COUNTRY=0;
        dbLangNordic = ;LANGID=0x041D;CP=1252;COUNTRY=0;
        dbLangNorwDan = ;LANGID=0x0414;CP=1252;COUNTRY=0;
        dbLangPolish = ;LANGID=0x0415;CP=1250;COUNTRY=0;
        dbLangCyrillic = ;LANGID=0x0419;CP=1251;COUNTRY=0;
        dbLangSpanish = ;LANGID=0x040A;CP=1252;COUNTRY=0;
        dbLangSwedFin = ;LANGID=0x040B;CP=1252;COUNTRY=0;
        dbLangTurkish = ;LANGID=0x041F;CP=1254;COUNTRY=0;
        dbLangJapanese = ;LANGID=0x0411;CP=932;COUNTRY=0;
        dbLangChineseSimplified = ;LANGID=0x0804;CP=936;COUNTRY=0;
        dbLangChineseTraditional = ;LANGID=0x0404;CP=950;COUNTRY=0;
        dbLangKorean = ;LANGID=0x0412;CP=949;COUNTRY=0;
        dbLangThai = ;LANGID=0x041E;CP=874;COUNTRY=0;
        dbLangSlovenian = ;LANGID=0x0424;CP=1250;COUNTRY=0;    3、关于CreateDatabase中数据库版本信息
       Enum DatabaseTypeEnum;
        dbVersion10 = 1;
        dbEncrypt = 2;
        dbDecrypt = 4;
        dbVersion11 = 8;
        dbVersion20 = 16;
        dbVersion30 = 32;    4、其它方面，希望各位再加补充。

Answer 2

function TFormMain.CompactDatabase(AFileName,APassWord:string):boolean;
//压缩与修复数据库,覆盖源文件
const
  SConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
      +'Jet OLEDB:Database Password=%s;';
var
  SPath,SFile:Array [0..254] Of Char;
  STempFileName:String;
  JE:OleVariant;
begin
  DataSource1.DataSet.Active:=False;
  ADOConnection1.Connected:=False;
  GetTempPath(40,SPath);//取得Windows的Temp路径
  GetTempFileName(SPath,'~CP',0,SFile);//取得Temp文件名,Windows将自动建立0字节文件
  STempFileName:=SFile;//PChar->String
  DeleteFile(STempFileName);//删除Windows建立的0字节文件
  try
    JE:=CreateOleObject('JRO.JetEngine');//建立OLE对象,函数结束OLE对象超过作用域自动释放
    OleCheck(JE.CompactDatabase(format(SConnectionString,[AFileName,APassWord]),
        format(SConnectionString,[STempFileName,APassWord])));//压缩数据库
    //复制并覆盖源数据库文件,如果复制失败则函数返回假,压缩成功但没有到函数的功能
    result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);
    DeleteFile(STempFileName);//删除临时文件
  except
    result:=false;//压缩失败
  end;
  ADOConnection1.Connected:=True;
  DataSource1.DataSet.Active:=True;
end;procedure TFormMain.LMDButton1Click(Sender: TObject);
begin
  CompactDatabase(ExtractFilePath(Application.ExeName)+'Default.mdb','123456');
  //123456是密码，
end;

Answer 3

其实 Drate(鸟窝里的虫)　说得更为详尽

Answer 4

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
   dao:OLEVariant;
   tstr1,tstr2:string;
   winpath:pchar;
begin
    my_locate_conn.Close;
    GetMem(WinPath,255);
    GetWindowsDirectory(WinPath,255);
    Tstr1:=WinPath;
    dao:=CreateOleObject('DAO.DBEngine.36');
    Tstr2:=Tstr1+'\_tem5.bak';
    Tstr1:=Tstr1+'\_tem5.tem';  //解密后的文件--正常文件
    dao.CompactDatabase(tstr1,tstr2);
    deletefile(tstr1);
    RenameFile(tstr2,tstr1);
    tstr2:=ExtractFilePath(ParamStr(0))+'db\l_song.mdb';
你看看吧,这就可以了,但在使用前要将 DAO360。DLL注册,这个文件在安装OFFICE2000后会自动注册

Answer 5

Function CompactAndRepair(sOldMDB:String;sNewMDB:String;psw:string;password:boolean):Boolean;
const
  sProvider='Provider=Microsoft.Jet.OLEDB.4.0;';
var
  oJetEng:JetEngine;
begin
  if password then
    sOldMDB:=sProvider+'Data Source='+sOldMDB+';jet oledb:database password="'+psw+'"'
  else
    sOldMDB:=sProvider+'Data Source='+sOldMDB;
    
  if password then
     sNewMDB:=sProvider+'Data Source='+sNewMDB+';jet oledb:database password="'+psw+'"'
  else
     sNewMDB:=sProvider+'Data Source='+sNewMDB;
  try
    oJetEng:=CoJetEngine.Create;
    oJetEng.CompactDatabase(sOldMDB, sNewMDB);    
    oJetEng:=Nil;
    Result:=True;
  except
    oJetEng:=Nil;
    Result:=False;
  end;
end; {10.CompactAndRepair(压缩Access数据库，用到JRO_TLB单元,可按下面方法加入)   }
{ a) 在Delphi IDE中选择Project - Import Type Library.                      }
{ b) 往下翻直到你找到“Microsoft Jet and Replication Objects 2.1 Library”.}

Answer 6

onclick事件中调用的例子(菜单里的，不是你所要求的btn，但我想应该是一样的吧)：procedure Tmainform.N31Click(Sender: TObject);
begin
  if application.MessageBox('压缩数据库可以节省硬盘空间，但系统的性能可能会略微下降，确实要压缩数据库吗？','询问',mb_yesno+mb_defbutton2+mb_iconquestion)=idyes then
     begin
       datamodule1.ADOConnection1.Connected:=false;
       if CompactAndRepair('junhua.9sky', 'junhua1.mdb','jiutiankaifabuchupin',true) then
          begin
            if copyfile('junhua1.mdb','junhua.9sky',false) then
               deletefile('junhua1.mdb');
            ShowMessage('数据库压缩成功！系统即将关闭。');
            application.Terminate;
          end
       else
         ShowMessage('压缩数据库出错！');
     end; 
end;