Fatal编程技术网
  • delphi/
  • Delphi 压缩Access数据库

Delphi 压缩Access数据库

delphi ms-access

Delphi 压缩Access数据库,delphi,ms-access,ado,delphi-xe4,Delphi,Ms Access,Ado,Delphi Xe4,我正在尝试压缩Microsoft Access数据库，但下面显示的代码不起作用 procedure TForm1.Disconnect1Click(Sender: TObject); begin ADODataSet1.Active := False; ADOTable1.Active := False; ADODataSet1.Connection := nil; DataSource1.Enabled := False; ADOConnection1.Connected

我正在尝试压缩Microsoft Access数据库，但下面显示的代码不起作用

procedure TForm1.Disconnect1Click(Sender: TObject);
begin
  ADODataSet1.Active := False;
  ADOTable1.Active := False;
  ADODataSet1.Connection := nil;
  DataSource1.Enabled := False;
  ADOConnection1.Connected := False;
  JetEngine1.Disconnect;
end;

function DatabaseCompact(const sdbName: WideString): boolean;
{ Compact ADO mdb disconnected database. }
var
  iJetEngine: TJetEngine; { Jet Engine }
  iTempDatabase: WideString; { TEMP database }
  iTempConn: WideString; { Connection string }
const
  iProvider = 'Provider=Microsoft.Jet.OLEDB.4.0; Data Source=';
begin
  Result := False;
  iTempDatabase := ExtractFileDir(sdbName) + 'TEMP' + ExtractFileName(sdbName);
  iTempConn := iProvider + iTempDatabase;
  if FileExists(iTempDatabase) then
    DeleteFile(iTempDatabase);
  iJetEngine := TJetEngine.Create(Application);
  try
    try
      iJetEngine.CompactDatabase(iProvider + sdbName, iTempConn);
      DeleteFile(sdbName);
      RenameFile(iTempDatabase, sdbName);
    except
      on E: Exception do
        ShowMessage(E.Message);
    end;
  finally
    iJetEngine.FreeOnRelease;
    Result := True;
  end;
end;

procedure TForm1.Compact1Click(Sender: TObject);
var
  iResult: Integer;
begin
  AdvTaskDialog1.Clear;
  AdvTaskDialog1.Title := 'Compact Database';
  AdvTaskDialog1.Instruction := 'Compact Database';
  AdvTaskDialog1.Content := 'Compact the database?';
  AdvTaskDialog1.Icon := tiQuestion;
  AdvTaskDialog1.CommonButtons := [cbYes, cbNo];
  iResult := AdvTaskDialog1.Execute;
  if iResult = mrYes then
  begin
    Screen.Cursor := crHourglass;
    try
      DatabaseCompact('D:\RadProjects10\EBook Database\EBook Database.mdb');
      ADODataSet1.Connection := ADOConnection1;
      ADOConnection1.Connected := True;
    finally
      Screen.Cursor := crDefault;
    end;
  end;
end;

procedure TForm1.Connect1Click(Sender: TObject);
begin
  ADOConnection1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;' +
    'User ID=Admin;' +
    'Data Source=D:\RadProjects10\EBook Database\EBook Database.mdb;' +
    'Mode=Share Deny None;' + 'Jet OLEDB:System database="";' +
    'Jet OLEDB:Registry Path="";' + 'Jet OLEDB:Database Password="";' +
    'Jet OLEDB:Engine Type=5;' + 'Jet OLEDB:Database Locking Mode=1;' +
    'Jet OLEDB:Global Partial Bulk Ops=2;' +
    'Jet OLEDB:Global Bulk Transactions=1;' +
    'Jet OLEDB:New Database Password="";' +
    'Jet OLEDB:Create System Database=False;' +
    'Jet OLEDB:Encrypt Database=False;' +
    'Jet OLEDB:Don''t Copy Locale on Compact=False;' +
    'Jet OLEDB:Compact Without Replica Repair=False;' + 'Jet OLEDB:SFP=False;';
  ADODataSet1.Connection := ADOConnection1;
  ADOConnection1.Connected := True;
  ADODataSet1.Active := True;
  ADOTable1.Active := True;
  DataSource1.Enabled := True;
end;
即使在压缩之前断开了数据库连接，但仍会收到一条错误消息：

您试图打开已由计算机“xxxx”上的用户“Admin”独占打开的数据库。请在数据库可用时重试

我断开连接，然后压缩，但出现了一些问题。我知道压缩Access数据库很好，所以我尝试用我编写的一个小应用程序来存储联系信息

显然，我用来断开与数据库连接的代码不起作用。我在哪里失败了？

在关闭
TADOConnection
和与之相关的所有数据集后，您需要确保数据库已解锁。请记住，其他用户可能连接到数据库，在这种情况下，您无法压缩它

在实际压缩db之前，您必须给jet引擎一点时间来实际关闭连接、刷新和解锁db。然后测试数据库是否已锁定（尝试打开以供独占使用）

以下是我使用的方法，它一直对我有效：

uses ComObj;

procedure JroRefreshCache(ADOConnection: TADOConnection);
var
  JetEngine: OleVariant;
begin
  if not ADOConnection.Connected then Exit;
  JetEngine := CreateOleObject('jro.JetEngine');
  JetEngine.RefreshCache(ADOConnection.ConnectionObject);
end;

procedure JroCompactDatabase(const Source, Destination: string);
var
  JetEngine: OleVariant;
begin
  JetEngine := CreateOleObject('jro.JetEngine');
  JetEngine.CompactDatabase(
    'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + Source,
    'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + Destination + ';Jet OLEDB:Engine Type=5');
end;

procedure CompactDatabase(const MdbFileName: string;
  ADOConnection: TADOConnection=nil;
  const ReopenConnection: Boolean=True);
var
  LdbFileName, TempFileName: string;
  FailCount: Integer;
  FileHandle: Integer;
begin
  TempFileName := ChangeFileExt(MdbFileName, '.temp.mdb');
  if Assigned(ADOConnection) then
  begin
    // force the database engine to write data to disk, releasing locks on memory
    JroRefreshCache(ADOConnection);
    // close the connection - this will also close all associated datasets
    ADOConnection.Close;
  end;
  // ADOConnection.Close SHOULD delete the ldb
  // force delete of ldb lock file just in case if we don't have an active ADOConnection
  LdbFileName := ChangeFileExt(MdbFileName, '.ldb');
  if FileExists(LdbFileName) then
    DeleteFile(LdbFileName); // could fail because data is still locked - we ignore this
  // delete temp file if any
  if FileExists(TempFileName) then
    if not DeleteFile(TempFileName) then
       RaiseLastOSError;
  // try to open for exclusive use
  FailCount := 0;
  repeat
    FileHandle := FileOpen(MdbFileName, fmShareExclusive);
    try
      if FileHandle = -1 then // error
      begin 
        Inc(FailCount);
        Sleep(100); // give the database engine time to close completely and unlock
      end
      else
      begin
        FailCount := 0;
        Break; // success
      end;
    finally
      FileClose(FileHandle);
    end;
  until FailCount = 10; // maximum 1 second of attempts      
  if FailCount <> 0 then // file is probably locked by another user/process        
    raise Exception.Create(Format('Error opening %s for exclusive use.', [MdbFileName]));
  // compact the db
  JroCompactDatabase(MdbFileName, TempFileName);
  // copy temp file to original mdb and delete temp file on success
  if Windows.CopyFile(PChar(TempFileName), PChar(MdbFileName), False) then
    DeleteFile(TempFileName)
  else
    RaiseLastOSError;
  // reopen ADOConnection
  if Assigned(ADOConnection) and ReopenConnection then
    ADOConnection.Open;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CompactDatabase('F:\Projects\DB\mydb.mdb', ADOConnection1, True);
  // reopen DataSets
  ADODataSet1.Open;
end;

使用ComObj；
过程JroRefreshCache（ADOConnection:TADOConnection）；
变量
叶藤碱：油变异体；
开始
如果未连接。已连接，则退出；
JetEngine:=CreateOleObject（'jro.JetEngine'）；
RefreshCache（ADOConnection.ConnectionObject）；
结束；
过程JroCompactDatabase（常量源，目标：字符串）；
变量
叶藤碱：油变异体；
开始
JetEngine:=CreateOleObject（'jro.JetEngine'）；
JetEngine.CompactDatabase(
“Provider=Microsoft.Jet.OLEDB.4.0；数据源=”+Source，
'Provider=Microsoft.Jet.OLEDB.4.0；数据源='+Destination+'；Jet-OLEDB:Engine-Type=5'）；
结束；
过程压缩数据库（const MdbFileName:string；
ADOConnection:TADOConnection=nil；
常量连接：布尔值=真）；
变量
LdbFileName，TempFileName:字符串；
失败计数：整数；
FileHandle：整数；
开始
TempFileName:=ChangeFileExt（MdbFileName，.temp.mdb'）；
如果已分配（ADO连接），则
开始
//强制数据库引擎将数据写入磁盘，释放内存锁
jrrefreshcache（ADOConnection）；
//关闭连接-这也将关闭所有关联的数据集
连接。关闭；
结束；
//ADOConnection.Close应删除ldb
//强制删除ldb锁文件，以防我们没有活动的ADO连接
LdbFileName:=ChangeFileExt（MdbFileName，.ldb'）；
如果文件存在（LdbFileName），则
删除文件（LdbFileName）；//可能会失败，因为数据仍然被锁定-我们忽略了这一点
//删除临时文件（如果有）
如果文件存在（TempFileName），则
如果不删除文件（TempFileName），则
赖斯·塞罗；
//试着打开专供使用
故障计数：=0；
重复
FileHandle:=FileOpen（MdbFileName，fmShareExclusive）；
尝试
如果FileHandle=-1，则//错误
开始
公司（故障计数）；
睡眠（100）；//让数据库引擎有时间完全关闭并解锁
结束
其他的
开始
故障计数：=0；
中断；//成功
结束；
最后
FileClose（FileHandle）；
结束；
直到故障计数=10；//最多1秒的尝试次数
如果失败计数为0，则//文件可能已被其他用户/进程锁定
引发异常。创建（格式（'Error opening%s for excluse.'，[MdbFileName]）；
//压缩数据库
JroCompactDatabase（MdbFileName，TempFileName）；
//将临时文件复制到原始mdb，并在成功时删除临时文件
如果Windows.CopyFile（PChar（TempFileName）、PChar（MdbFileName）、False），则
删除文件（临时文件名）
其他的
赖斯·塞罗；
//重新打开连接
如果已分配（ADOConnection）并重新连接，则
连接。打开；
结束；
程序TForm1.按钮1单击（发送方：TObject）；
开始
CompactDatabase（'F:\Projects\DB\mydb.mdb'，ADOConnection1，True）；
//重新打开数据集
ADODataSet1.Open；
结束；
确保在IDE（设计模式）中将
TADOConnection
设置为
Connected
。
因为如果是这样，则会有另一个到db的活动连接。

使用ComObj；

uses ComObj;
// with or without password 
procedure CompactDatabasev2(const MdbFileName: string; const PW:string='');
var
     LdbFileName, TempFileName: string;
     FailCount: Integer;
     FileHandle: Integer;
     JetEngine: OleVariant;
begin
     TempFileName  :=  ChangeFileExt(MdbFileName, '.temp.mdb');
     LdbFileName  :=  ChangeFileExt(MdbFileName, '.ldb');
     if FileExists(LdbFileName) then
          DeleteFile(LdbFileName); // could fail because data is still locked - we ignore this
      if FileExists(TempFileName) then       // delete temp file if any
          if not DeleteFile(TempFileName) then
               RaiseLastOSError;
  // try to open for exclusive use
     FailCount  :=  0;
     repeat
          FileHandle  :=  FileOpen(MdbFileName, fmShareExclusive);
          try
               if FileHandle  =  -1 then // error
               begin
                    Inc(FailCount);
                    Sleep(100); // give the database engine time to close completely and unlock
               end
               else
               begin
                    FailCount  :=  0;
                    Break; // success
               end;
          finally
               FileClose(FileHandle);
          end;
     until FailCount  =  10; // maximum 1 second of attempts
     if FailCount  <>  0 then // file is probably locked by another user/process
          raise Exception.Create(Format('Error opening %s for exclusive use.', [MdbFileName]));
    if PW='' then
    // DB DE PAROLA YOKSA
    begin
     JetEngine  :=  CreateOleObject('jro.JetEngine');
     JetEngine.CompactDatabase(
                                 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='  +  MdbFileName
                               , 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='  +  TempFileName  +  ';Jet OLEDB:Engine Type=5'
                               );

   end
    else
     // DB PAROLA VARSA
    begin
     JetEngine  :=  CreateOleObject('jro.JetEngine');
     JetEngine.CompactDatabase(
                               'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='  + MdbFileName + ';Jet OLEDB:Database Password='+PW
                             , 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='  + TempFileName +';Jet OLEDB:Database Password='+PW+';Jet OLEDB:Engine Type=5') ;

    end;


  // copy temp file to original mdb and delete temp file on success
     if CopyFile(PChar(TempFileName), PChar(MdbFileName), False) then
          DeleteFile(TempFileName)
     else
          RaiseLastOSError;


end;


//有密码还是没有密码
过程CompactDatabasev2（常量MdbFileName:string；常量PW:string=''）；
变量
LdbFileName，TempFileName:字符串；
失败计数：整数；
FileHandle：整数；
叶藤碱：油变异体；
开始
TempFileName:=ChangeFileExt（MdbFileName，.temp.mdb'）；
LdbFileName:=ChangeFileExt（MdbFileName，.ldb'）；
如果文件存在（LdbFileName），则
删除文件（LdbFileName）；//可能会失败，因为数据仍然被锁定-我们忽略了这一点
如果存在文件（TempFileName），则//删除临时文件（如果有）
如果不删除文件（TempFileName），则
赖斯·塞罗；
//试着打开专供使用
故障计数：=0；
重复
FileHandle:=FileOpen（MdbFileName，fmShareExclusive）；
尝试
如果FileHandle=-1，则//错误
开始
公司（故障计数）；
睡眠（100）；//让数据库引擎有时间完全关闭并解锁
结束
其他的
开始
故障计数：=0；
中断；//成功
结束；
最后
FileClose（FileHandle）；
结束；
直到故障计数=10；//最多1秒的尝试次数
如果失败计数为0，则//文件可能已被其他用户/进程锁定
引发异常。创建（格式（'Error opening%s for excluse.'，[MdbFileName]）；
如果PW=''，那么
//约克萨帕罗拉酒店
开始
JetEngine:=CreateOleObject（'jro.JetEngine'）；
JetEngine.CompactDatabase(
“Provider=Microsoft.Jet.OLEDB.4.0；数据源=”+MdbFileName
专业人士