function CompactInterBaseDatabase(DatabaseName, UserName, Password: string):

  boolean;

var

  tmpStr: array[0..MAX_PATH] of Char;

  TempPath: string; // путь

  ib_path: string; // путь сервера IB

  TempName: string; // имя временного файла

  bckName: string; //

  reg: TRegistry;

  si: STARTUPINFO;

  pi: PROCESS_INFORMATION;

  cmdline: string;

  SaveCursor: TCursor;

begin

  {

  используемые параметры командной строки

  -B(ACKUP_DATABASE) backup database to file

  -C(REATE_DATABASE) create database from backup file

  -PAS InterBase password

  -USER InterBase user name

  }

  result := false;

  SaveCursor := Screen.Cursor;

  Screen.Cursor := crHourGlass; // показываем часики

  try

    try // достаем размещение сервера IB

      Reg := TRegistry.Create;

      Reg.RootKey := HKEY_LOCAL_MACHINE;

      Reg.OpenKey('SOFTWARE\Borland\InterBase\CurrentVersion', False);

      ib_path := Reg.ReadString('ServerDirectory');

    finally

      Reg.Free;

    end;

    bckName := ChangeFileExt(ExtractFileName(DatabaseName), '.tmp');

    // получаем путь для временного файла

    TempPath := ExtractFilePath(DatabaseName);

    if TempPath = '' then

    begin

      TempPath := GetCurrentDir;

      DatabaseName := TempPath + '\' + DatabaseName;

    end;

    //получаем имя временного файла

    GetTempFileName(PChar(TempPath), 'gdb', 0, tmpStr);

    TempName := StrPas(tmpStr);

    // меняем ему расширение

    TempName := TempPath + '\' + ChangeFileExt(ExtractFileName(TempName),

      '.gdb');

    DeleteFile(PChar(TempName)); // этого файла не должно существовать :))

    ZeroMemory(@si, sizeof(si));

    si.cb := SizeOf(si);

    // прячем черное окошко. Если не надо прятать - то надо

    // просто убрать эти 2 строки

    si.dwFlags := STARTF_USESHOWWINDOW;

    si.wShowWindow := SW_HIDE;

    //-----------------------

    cmdline := ib_path + 'gbak.exe -b ' + DatabaseName + ' ' + TempName +

      ' -pas ' + Password + ' -user ' + UserName;

    if not CreateProcess(nil, // Используем командную строку.

      PChar(cmdline), // Командная строка.

      nil,

      nil, //

      False, //

      0, // флаги создания

      nil, // переменные окружения не меняем

      nil, // текущая директория не изменна

      si, // указатель на структуру STARTUPINFO .

      pi) {// указатель на структуру PROCESS_INFORMATION .} then

    begin

      raise ERangeError.CreateFmt(

        'Error in CompactInterBaseDatabase'#10#13'%s '  ,

        ['CreateProcess failed.']);

    end;

    WaitForSingleObject(pi.hProcess, INFINITE); // ждем бесконечно долго :)

    CloseHandle(pi.hProcess); // за собой надо

    CloseHandle(pi.hThread); // убирать

    RenameFile(DatabaseName, bckName);

    // переименовываем не упакованную базу - на всякий случай

    cmdline := ib_path + 'gbak.exe -c ' + TempName + ' ' + DatabaseName +

      ' -pas ' + Password + ' -user ' + UserName;

    if not CreateProcess(nil, // Используем командную строку.

      PChar(cmdline), // Командная строка.

      nil,

      nil, //

      False, //

      0, // флаги создания

      nil, // переменные окружения не меняем

      nil, // текущая директория не изменна

      si, // указатель на структуру STARTUPINFO .

      pi) {// указатель на структуру PROCESS_INFORMATION .} then

    begin

      raise ERangeError.CreateFmt(

        'Error in CompactInterBaseDatabase'#10#13'%s '  ,

        ['CreateProcess failed.']);

    end;

    WaitForSingleObject(pi.hProcess, INFINITE); // ждем бесконечно долго :)

    CloseHandle(pi.hProcess); // за собой надо

    CloseHandle(pi.hThread); // убирать

    DeleteFile(PChar(TempName)); // удаляем временный файл

    DeleteFile(PChar(bckName)); // удаляем не упакованную базу

    result := true; //все вроде вышло

  except // случилось страшное :)) Возвращаем все к прежнему виду

    on E: Exception do

    begin

      RenameFile(bckName, DatabaseName); // переименовываем не упакованную базу

      DeleteFile(PChar(TempName)); // удаляем временный файл

      result := false; // результат выполнения функции отрицателен

      // выдаем сообщение об исключительной ситуации

      ShowMessage(e.message);

    end;

  end;

  Screen.Cursor := SaveCursor; // возвращаем курсор на место

end;

...if CompactInterBaseDatabase('any_db.gdb', 'SYSDBA', 'masterkey') then

  ShowMessage('Done!');

...