Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Базы данных и репортинг > ADO (MS Access) Хранение картинки


Автор: iddqd 23.12.2005, 13:16
Я сохраняю картинку в базе данных. Затем заменяю её другой или удаляю вовсе.
Но размер базы данных увеличивается при замене и остаётся прежним при изменении.
В самом Access есть пункт "Сжать и оптимизировать" тогда размер становиться нормальным. А можно это как-нибудь сделать через дельфи?

Автор: FRAGNATIC 23.12.2005, 16:42
Код

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

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

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


Код

{ **** 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, [email protected], 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;
...



© DelphiWorld

Автор: iddqd 23.12.2005, 17:35
Спасибо. То, что надо. Всё работает.

Автор: offline 23.12.2005, 21:37
Я сжимаю так

Код

var je: Variant;
begin
 try
 Screen.Cursor := crHourGlass;//курсор в ожидание
 conn.Close;
 je:=CreateOleObject('JRO.JetEngine');
 je.CompactDatabase('Provider=Microsoft.Jet.OLEDB.4.0;'+
                    'Data Source= База mdb;'+
                    'Jet OLEDB:Database Password= пароль',
                    'Provider=Microsoft.Jet.OLEDB.4.0;'+
                    'Data Source=временная база NewBase$$$.mdb;'+
                    'Jet OLEDB:Encrypt Database=True;'+
                    'Jet OLEDB:Database Password= пароль' );
 DeleteFile(PChar('удаляем старую базу mdb'));
 RenameFile('переименовываем новую базу NewBase$$$.mdb', 'в старую базу mdb');
 conn.Open;
 Screen.Cursor := crDefault;
 except
  ShowMessage('Возникло исключение ' + E.Message);
  conn.Open;
  Screen.Cursor := crDefault;
 end;
end;


smile

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)