Процедура позволяет сжать базу данных в формате 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;
...
}