Delphi World - Программное сжатие базы данных Access используя JRO (Jet Replication Objects)
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Программное сжатие базы данных Access используя JRO (Jet Replication Objects)

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

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

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

PS. этот код был написан в связи с тем что аналогичная процедура
через DAO у многих не работала (по пока неизвестным для меня причинам)

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

procedure CompactDatabase_JRO(DatabaseName: string; DestDatabaseName: string =
  ''; Password: string = '');
const
  Provider = 'Provider=Microsoft.Jet.OLEDB.4.0;';
var
  TempName: array[0..MAX_PATH] of Char; // имя временного файла
  TempPath: string; // путь до него
  Name: string;
  Src, Dest: WideString;
  V: Variant;
begin
  try
    Src := Provider + 'Data Source=' + DatabaseName;
    if DestDatabaseName <> '' then
      Name := DestDatabaseName
    else
    begin
      // выходная база не указана - используем временный файл
      // получаем путь для временного файла
      TempPath := ExtractFilePath(DatabaseName);
      if TempPath = '' then
        TempPath := GetCurrentDir;
      //получаем имя временного файла
      GetTempFileName(PChar(TempPath), 'mdb', 0, TempName);
      Name := StrPas(TempName);
    end;
    DeleteFile(PChar(Name)); // этого файла не должно существовать :))
    Dest := Provider + 'Data Source=' + Name;
    if Password <> '' then
    begin
      Src := Src + ';Jet OLEDB:Database Password=' + Password;
      Dest := Dest + ';Jet OLEDB:Database Password=' + Password;
    end;

    V := CreateOleObject('jro.JetEngine');
    try
      V.CompactDatabase(Src, Dest); // сжимаем
    finally
      V := 0;
    end;
    if DestDatabaseName = '' then
    begin // т.к. выходная база не указана
      DeleteFile(PChar(DatabaseName)); //то удаляем не упакованную базу
      RenameFile(Name, DatabaseName); // и переименовываем упакованную базу
    end;
  except
    // выдаем сообщение об исключительной ситуации
    on E: Exception do
      ShowMessage(e.message);
  end;
end;

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

...
db.Close;
CompactDatabase_JRO('c:\database.mdb',
  'c:\Archiv\database_pack.mdb', 'password');
db.open;
...
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования