Сжать базу данных Access

Я пытаюсь сжать базу данных 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;

Несмотря на то, что я отключаю базу данных перед уплотнением, я получаю сообщение об ошибке:

Вы попытались открыть базу данных, которая уже открыта исключительно пользователем «Администратор» на машине «хххх». Повторите попытку, когда база данных будет доступна.

Я отключаю, а затем сжимаю, но что-то идет не так. Я понимаю, что хорошо уплотнять базу данных Access, поэтому я пытаюсь сделать это с помощью небольшого приложения, которое написал для хранения контактной информации.

Очевидно, код, который я использовал для отключения от базы данных, не работает. Где я потерпел неудачу?


delphi ms-access ado delphi-xe4
person Bill    schedule 14.11.2013    source источник

Ответы (1)


arrow_upward
9
arrow_downward

После закрытия TADOConnection и ВСЕХ наборов данных, связанных с ним, вам необходимо убедиться, что БД разблокирована. Помните, что другие пользователи могут подключаться к базе данных, и в этом случае вы не можете сжимать ее.

Перед фактическим сжатием базы данных вы должны дать реактивному двигателю немного времени, чтобы фактически закрыть соединение, очистить и разблокировать базу данных. Затем проверьте, заблокирована ли база данных (попробуйте открыть для монопольного использования).

Вот метод, который я использую, который всегда работал для меня:

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;

Убедитесь, что для вашего TADOConnection НЕ установлено значение Connected в среде IDE (режим конструктора).
Потому что, если это так, существует другое активное соединение с базой данных.

person kobik    schedule 14.11.2013
comment
Я попробовал ваш код, но все равно получаю, если FailCount ‹› 0, то // файл, вероятно, заблокирован другим пользователем/процессом. Исключение возникает в CompactDatabase. Я также попытался увеличить FailCount с 10 до 100. Моя база данных находится на компьютере, не подключенном к сети, и только это приложение имеет доступ к базе данных. - person Bill; 15.11.2013
comment
В моем предыдущем комментарии было отмечено исключение, когда приложение работало в XE4 IDE. Я только что попробовал приложение, выполнив EXE, и база данных была сжата без исключения? - person Bill; 15.11.2013
comment
Я предполагаю, что для вашего ADOConnection1 установлено значение Connected в среде IDE? Это означает, что другой пользователь уже подключен. - person kobik; 15.11.2013