我试图压缩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;
You attempted to open a database that is already opened exclusively by the user ‘Admin’ on the machine ‘xxxx’. Try again when the database is available.
解决方法
关闭TADOConnection和与之关联的所有DataSet后,您需要确保db已解锁.请记住,其他用户可能已连接到数据库,在这种情况下,您无法压缩它.
在实际压缩数据库之前,您必须给喷气引擎一些时间来实际关闭连接,刷新和解锁数据库.然后测试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;
确保在IDE(设计模式)中未将TADOConnection设置为Connected.因为如果是,则存在与db的另一个活动连接.