VPF::Компрессия БД - Форум программистов

cardinal

Дата 31.5.2005, 16:01 (ссылка)

(нет голосов)

Загрузка ...

Инженер

Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99

В проект вложим References для MS DAO Library

Код


Public Declare Function GetTempPath Lib "kernel32" Alias _
    "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer _
    As String) As Long

Public Const MAX_PATH = 260

 
Public Sub CompactJetDatabase(Location As String, _
    Optional BackupOriginal As Boolean = True)

   On Error GoTo CompactErr
    
   Dim strBackupFile As String
   Dim strTempFile As String

   ' если существует БД
   If Len(Dir(Location)) Then

' Если надо бэкапит файл
    If BackupOriginal = True Then
    strBackupFile = GetTemporaryPath & "backup.mdb"
    If Len(Dir(strBackupFile)) Then Kill strBackupFile
    FileCopy Location, strBackupFile
    End If

' Сделат временный файл БД
    strTempFile = GetTemporaryPath & "temp.mdb"
    If Len(Dir(strTempFile)) Then Kill strTempFile

' Сделать компресию БД
    DBEngine.CompactDatabase Location, strTempFile

' Стереть файл с базой данных
    Kill Location

' Копирование временной баззы даных
    FileCopy strTempFile, Location

' Стереть временный файл
    Kill strTempFile

   Else

End If

CompactErr:
    
    Exit Sub

End Sub

Public Function GetTemporaryPath()

   Dim strFolder As String
   Dim lngResult As Long

   strFolder = String(MAX_PATH, 0)
   lngResult = GetTempPath(MAX_PATH, strFolder)

   If lngResult <> 0 Then
     GetTemporaryPath = Left(strFolder, InStr(strFolder, _
      Chr(0)) - 1)
   Else
     GetTemporaryPath = ""
   End If

End Function

Употребление:

Код


Call CompactJetDatabase("e:\001.mdb")

--------------------

Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино". А. и Б. Стругацкие

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »