Автор: Savva
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Программное сжатие базы данных Access используя DAO

Процедура позволяет сжать базу данных в формате Access, используя DAO.
Действие аналогичное пункту меню в Access "Сервис -> Служебные программы ->
Сжать и восстановить базу данных".
Параметры:
* DatabaseName - путь к базе данных
* Password - пароль базы данных

Зависимости: windows,SysUtils,Dialogs,DAO2000,ComObj
(Dialogs можно исключить используя MessageBox для вывода
сообщения исключительной ситуации)
Автор:       savva, savva@nm.ru, ICQ:126578975, Орел
Copyright:   Сапронов Алексей (Savva)
Дата:        31 мая 2002 г.
***************************************************** }

//перед вызовом процедуры базу надо закрыть, а после - открыть

procedure TData.CompactAccessDatabase(DatabaseName, Password: string);
var
  TempName: array[0..MAX_PATH] of Char; // имя временного файла
  TempPath: string; // путь
  Name: string;
  tmpDAO: _DBEngine;
  ClassID: TGUID;
  V35, V36: string; // версия DAO
begin
  V35 := 'DAO.DBEngine.35';
  V36 := 'DAO.DBEngine.36';
  try // получим ClassID
    try
      ClassID := ProgIDToClassID(v35);
    except
      try
        ClassID := ProgIDToClassID(v36);
      except
        raise; // что то нам неизвестное
      end;
    end;
    // получаем путь для временного файла
    TempPath := ExtractFilePath(DatabaseName);
    if TempPath = '' then
      TempPath := GetCurrentDir;
    //получаем имя временного файла
    GetTempFileName(PChar(TempPath), 'mdb', 0, TempName);
    Name := StrPas(TempName);
    DeleteFile(PChar(Name)); // этого файла не должно существовать :))
    if Password <> '' then
      Password := ';pwd=' + Password;
    tmpDAO := CreateComObject(ClassID) as _DBEngine;
    tmpDAO.CompactDatabase(DatabaseName, Name, 0, 0, Password);
    DeleteFile(PChar(DatabaseName)); // удаляем не упакованную базу
    RenameFile(Name, DatabaseName); // переименовываем упакованную базу
  except
    // выдаем сообщение об исключительной ситуации
    on E: Exception do
      ShowMessage(e.message);
  end;
  еnd;

Пример использования:

...
db.Close;
CompactAccessDatabase('database.mdb', 'password');
db.open;
...