Программно сжать и восстановить БД в Access

Private sSourceFile, sDestFile As String
Private Sub btnOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOpen.Click
    If dlgOpen.ShowDialog = DialogResult.OK Then
        '///Используя OpenFileDialog, задаем путь до БД-источника
        txtOpen.Text = dlgOpen.FileName.ToString
    End If
End Sub
Private Sub btnSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSave.Click
    dlgSave.InitialDirectory = System.IO.Path.GetTempPath
    If dlgSave.ShowDialog = DialogResult.OK Then
        '///Используя SaveFileDialog, задаем путь для предпологаемой сжатой БД
        txtSave.Text = dlgSave.FileName.ToString
    End If
End Sub
Private Sub btnCmDb_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCmDb.Click
    sSourceFile = txtOpen.Text
    sDestFile = txtSave.Text
    If sSourceFile.Length <> 0 And sDestFile.Length <> 0 Then
        Dim sConn As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
                                sSourceFile & ";"
        Dim dConn As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
                                sDestFile & ";"
        Dim jro As New JRO.JetEngine
        Try
            '///Сжатие
            jro.CompactDatabase(sConn, dConn)
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        Finally
            jro = Nothing
        End Try
    End If
End Sub

{****************************************************
>> Программное сжатие базы данных 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;

WideString paths, pathd;
  ................
 Variant V;
 V=CreateOleObject("Access.Application");
 V.OlePropertyGet("DBEngine").OleFunction("CompactDatabase", paths, pathd);

void __fastcall TfrmMain::mnuPackDBClick(TObject *Sender)
{
WideString WSCurrConn, WSTempDB;
TBookmark Bookmark;
 
WSCurrConn        = dmMain->acMain->ConnectionString;
Bookmark          = adsMain->GetBookmark();
adsMain->Close();
dmMain->acMain->Close();
mnuCreateBackupClick(Sender);
 
Variant JE = Variant::CreateObject ("JRO.JetEngine");
 
try
 {
  JE.OleFunction ("CompactDatabase",  WSCurrConn,
   "Provider=Microsoft.Jet.OLEDB.4.0;Password="";Mode=ReadWrite;Data Source=temp.mdb");
  if(FileExists("temp.mdb"))
   {
    CopyFile("temp.mdb", "base.mdb", false);
    DeleteFile("temp.mdb");
   }
 }
__finally
 {
  JE                = Unassigned;
  dmMain->acMain->Open();
  adsMain->Open();
  if( adsMain->BookmarkValid(Bookmark) )
   adsMain->GotoBookmark(Bookmark);
 }
}

void __fastcall LFunction::CompactMdb(AnsiString LPath, AnsiString LPwd)  {
  AnsiString FName = LPath;
  AnsiString Ext = ExtractFileExt(LPath);
  AnsiString FNameNotExt = LPath.SubString(1,LPath.Pos(Ext) - 1);
  if(Ext.LowerCase() == ".mdb")  {
    if(!FileExists(FNameNotExt + ".ldb"))  {
      TJetEngine * JetEngine = new TJetEngine(NULL);
      WideString Source = "Provider=Microsoft.Jet.OLEDB.4.0; \
                           Jet OLEDB:Database Password=" + LPwd + "; \
                           Data Source=" + FName + ";";
      WideString Dest =   "Provider=Microsoft.Jet.OLEDB.4.0; \
                           Jet OLEDB:Database Password=" + LPwd + "; \
                           Data Source=" + FNameNotExt + "te1.mdb;";
      JetEngine->CompactDatabase(Source.c_bstr(), Dest.c_bstr());
      DeleteFile(FName);
      RenameFile(FNameNotExt + "te1.mdb",FName);
    delete JetEngine;
    }
  }
}