Программное сжатие базы данных Access используя DAO

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

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

Зависимости: windows,SysUtils,Dialogs,DAO2000,ComObj
(Dialogs можно исключить используя MessageBox для вывода
сообщения исключительной ситуации)
Автор: savva, 
 Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script
 , 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;
...