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

3/5 (11 avis)

Vue 7 389 fois - Téléchargée 696 fois

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

Ajouter un commentaire Commentaires

EvilGost

Messages postés: 235
Date d'inscription: lundi 16 décembre 2002
Statut: Membre
Dernière intervention: 16 mai 2011

2
12 mai 2006 à 11:24

Je confirme que l'utilisation de la compression via le Jet Engine sur une base Access 97 corrompt la base et devient illisible par la suite via access...

EvilGost

Messages postés: 235
Date d'inscription: lundi 16 décembre 2002
Statut: Membre
Dernière intervention: 16 mai 2011

2
8 févr. 2006 à 11:04

Si l'on veut que le compactage soit effectuer dans le même répertoire que celui où se trouve la base, il suffit de faire cela à la ligne 43:

sShortName = oFSO.GetParentFolderName(sLocalDatabase) & "" & oFSO.GetBaseName(sLocalDatabase)

Pour Patate, si c'est tout à fait possible, le fso ici sert surtout à la manipulation des fichiers, tu peux utiliser les fonctions vb de base come filecopy, kill, etc...

cs_PaTaTe

Messages postés: 2107
Date d'inscription: mercredi 21 août 2002
Statut: Contributeur
Dernière intervention: 19 février 2021

2
30 janv. 2005 à 01:13

c possible une version sans FSO ? parce que serieusement FSO ...

cs_jds

Messages postés: 8
Date d'inscription: mardi 17 décembre 2002
Statut: Membre
Dernière intervention: 26 novembre 2004

26 nov. 2004 à 03:06

Salut les gars, désolé j'ai corrigé quelques bug et ajouté le projet avec la MDB

zeunz

Messages postés: 200
Date d'inscription: jeudi 26 février 2004
Statut: Membre
Dernière intervention: 30 juin 2008

25 nov. 2004 à 19:45

http://www.vbfrance.com/forum.v2.aspx?ID=13815

Afficher les 11 commentaires

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.

Source / Exemple :

Conclusion :

A voir également

Vous n'êtes pas encore membre ? inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Vous n'êtes pas encore membre ?

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