ACCESS的压缩~~

Question

我想在备份之前先对access进行压缩，就像access自带的那个压缩工具那样。十几M的一次压成几百K

Answer 1

//压缩Access表procedure CompactDb(DbPath, DbName, Password: string);
var
  jt: TJetEngine;
begin
  jt := TjetEngine.Create(nil);
  try
    jt.CompactDatabase('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + DbPath + DbName + ';Jet OLEDB:DataBase PassWord=' + Password,
      'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + DbPath + 'Dest.mdb;Jet OLEDB:DataBase PassWord=' + password);
    DeleteFile(DbPath + DbName);
    RenameFile(DbPath + 'Dest.mdb', DbPath + DbName);
  finally
    jt.Free;
  end;
end;
//修复Access表procedure RepairDb(DbName: string);
var
  Dao: OLEVariant;
begin
  Dao := CreateOleObject('DAO.DBEngine.35');
  Dao.RepairDatabase(DbName);
end;

Answer 2

var
  jt: TJetEngine;这个是什么了？

Answer 3

上面的正解
但是现在基本没35版本的DAO啦改为36就好很多了http://lysoft.7u7.net

Answer 4

这个一定OK的
uses Sysutils, ComObj, Dialogs, Variants;function DaoActive(var DaoObject: OleVariant): Boolean;
begin
  Result:=False;
  try
    DaoObject:=GetActiveOleObject('DAO.DBEngine.36');
    Result:=True;
  except
    try
      DaoObject:=CreateOleObject('DAO.DBEngine.36');
      Result:=True;
    except
      DaoObject:=Null;
    end;
  end;
end;//Compact Access MDB file
function CompactMDB(const FileName: string): Boolean;
var
  db:OleVariant;
  TempFile:string;
begin
  Result:=False;
  try
    if not DaoActive(db) then
      Exit;
    try
      TempFile:=ExtractFilePath(FileName)+'~msaTemp.mdb';
      db.CompactDatabase(FileName, TempFile);
      DeleteFile(FileName);
      RenameFile(TempFile, FileName);
      Result:=True;
    except
      on E:EOleException do
        ShowMessage(E.Message);
    end
  finally
    db:=Unassigned;
  end;
end;// Repair Access MDB file
function RepairMDB(const FileName: string): Boolean;
var
  db:OleVariant;
begin
  Result:=False;
  try
    if not DaoActive(db) then
      Exit;
    try
      db.RepairDatabase(FileName);
      Result:=True;
    except
      on E:EOleException do
        ShowMessage(E.Message);
    end
  finally
    db:=Unassigned;
  end;
end;http://lysoft.7u7.net

Answer 5

菜单 project - import type library选择
Microsoft Jet and Repliction Objects 2.x Library导入，就有TJetEngine 

Answer 6

我以前的代码：library Compact2K;
uses
  SysUtils,
  Classes,
  Windows,
  JRO_TLB in 'D:\Program Files\Borland\Delphi7\Imports\JRO_TLB.pas';{$R *.res}function CompactMDB(pPath : Pchar):Boolean;stdcall;
const
  Provider = 'Provider=Microsoft.Jet.OLEDB.4.0;';
var
  JetEng: JetEngine;
  Src, Dest: WideString;
  sPath, sFN: string;
  i: Integer;
begin
  Result := False;
  JetEng := CoJetEngine.Create;
  //sPath := DataModule1.ADOConnection1.ConnectionString;
  sPath := StrPas(pPath);
  I := Pos('Data Source=', sPath);
  Delete(sPath, 1, I + 11);
  I := Pos(';Mode=Share Deny None', Spath);
  Delete(sPath, I, 1000);  sFN := ExtractFileName(sPath);
  sPath := ExtractFilePath(sPath);
  Src := Provider + 'Data Source =' + sPath + sFN;
  Dest := Provider + 'Data Source =' + sPath + 'Cpt' + sFN;
  try
    if FileExists(sPath + 'Cpt' + sFN) then
      DeleteFile(Pchar(sPath + 'Cpt' + sFN));
    JetEng.CompactDatabase(Src, Dest);    CopyFile(PChar(sPath + sFN), PChar(sPath + ChangeFileExt(sFn, '.bak')),
      False);
    DeleteFile(Pchar(sPath + sFn));
    CopyFile(PChar(sPath + 'Cpt' + sFN), PChar(sPath + sFn), False);
   Result := True;
  finally
    JetEng := nil;
  end;
end;exports
   CompactMDB Index 1;
begin
end.