| Код | { **** 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 |