Compacter une base de données access protégée par un mot de passe

Télécharger le projet
Commenter

Description

Ce code permet de compacter une base de données access protégée par un mot de passe. Ceci est nécessaire afin d'éviter que la base ne devienne énorme. Ce code est très rapide et léger en resources.

Dans votre projet faites référence à ces 3 Composants :
1. Microsoft Jet and Replication Objets 2.6 library
2. Microsoft DAO 3.6 Object Library
3. Microsoft Scripting Runtime

Source / Exemple : 


'**************************************************************
'purpose : this code Compacts a database protected by a password
'
'Project References :
'--------------------
'  1. Microsoft Jet and Replication Objets 2.6 library
'  2. Microsoft DAO 3.6 Object Library
'  3. Microsoft Scripting Runtime
'**************************************************************
Option Explicit

'remplacer cette constante par votre mot de passe
Const c_sPASSWORD As String = "pwd"
Const c_sDATABASE As String = "MaBasedeDonnées.mdb"

Public Sub main()
'remplacer la DB par la votre
 Dim sPath
 sPath = App.Path
 If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
 CompactDataBaseAccess sPath & c_sDATABASE, c_sPASSWORD
End Sub

'**************************************************************
'purpose : this sub compacts a database using JRO
'params: LocalDatabase : The actual db
'        sPassword : The DB password
'
'**************************************************************
Public Sub CompactDataBaseAccess(sLocalDatabase As String, sPassword As String)
    
    On Error GoTo ERRORHANDLER
    Screen.MousePointer = vbHourglass
    
    Dim oFSO As FileSystemObject
    Dim oJRO As JRO.JetEngine
    Dim sShortName As String, sExt As String
    Dim sCompactPart1    As String
    Dim sCompactPart2    As String
    
    Set oFSO = New FileSystemObject
    sShortName = oFSO.GetBaseName(sLocalDatabase)
    sExt = ".Bak"
    sShortName = sShortName & sExt

    sCompactPart1 = "Provider=Microsoft.Jet.OLEDB.4.0" & _
        ";Data Source=" & sLocalDatabase
    sCompactPart2 = "Provider=Microsoft.Jet.OLEDB.4.0" & _
        ";Data Source=" & sShortName
 
    ChangeDBPassword "", sLocalDatabase
    
    Set oJRO = New JRO.JetEngine
    oJRO.CompactDatabase sCompactPart1, sCompactPart2
    
    ' delete the original database
    oFSO.DeleteFile sLocalDatabase
    oFSO.MoveFile sShortName, sLocalDatabase
    
    ChangeDBPassword sPassword, sLocalDatabase
    
EXITPOINT:
    Screen.MousePointer = vbDefault
    If Not oFSO Is Nothing Then
      Set oFSO = Nothing
    End If
    If Not oJRO Is Nothing Then
      Set oJRO = Nothing
    End If
    Exit Sub

ERRORHANDLER:
    Resume EXITPOINT
End Sub

'**************************************************************
'purpose : this sub changes the password of a database using DAO
'params: sPassword : The acutal db password
'   SDatabase : The Database file Name
'
'**************************************************************
Private Sub ChangeDBPassword(sPassword As String, sLocalDatabase As String)
    On Error GoTo ERRORHANDLER
     
     Dim oMDBDatabase As Database

     Select Case sPassword
      Case c_sPASSWORD
          Set oMDBDatabase = OpenDatabase(sLocalDatabase, True, False)
          oMDBDatabase.NewPassword "", c_sPASSWORD
      Case Else
          Set oMDBDatabase = OpenDatabase(sLocalDatabase, True, False, _
          ";pwd=" & c_sPASSWORD)
          oMDBDatabase.NewPassword c_sPASSWORD, ""
     End Select
     oMDBDatabase.Close

EXITPOINT:
    Exit Sub

ERRORHANDLER:
    Resume EXITPOINT

End Sub

Conclusion :


JDS
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.