delphi – Compact Access数据库
发布时间：2020-12-15 09:33:56 所属栏目：大数据 来源：网络整理
导读：我试图压缩Microsoft Access数据库,但下面显示的代码不起作用. procedure TForm1.Disconnect1Click(Sender: TObject);begin ADODataSet1.Active := False; ADOTable1.Active := False; ADODataSet1.Connection := nil; DataSource1.Enabled := False; ADOCon
|
我试图压缩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:RadProjects10EBook DatabaseEBook 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:RadProjects10EBook DatabaseEBook 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;
即使我在压缩之前断开数据库,我收到一条错误消息：
我断开然后紧凑,但出了点问题.我知道压缩Access数据库是好的,所以我试图用我编写的一个小应用程序来存储联系信息. 显然我用来与数据库断开连接的代码不起作用.我在哪里失败了？ 解决方法
关闭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:ProjectsDBmydb.mdb',ADOConnection1,True);
// reopen DataSets
ADODataSet1.Open;
end;
确保在IDE(设计模式)中未将TADOConnection设置为Connected.因为如果是,则存在与db的另一个活动连接. （编辑：李大同） 【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容! |