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

Soyez le premier à donner votre avis sur cette source.

Vue 6 452 fois - Téléchargée 637 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

Signaler
EvilGost
Messages postés
235
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
16 mai 2011
 2 -
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...
Signaler
EvilGost
Messages postés
235
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
16 mai 2011
 2 -
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...
Signaler
cs_PaTaTe
Messages postés
1878
Date d'inscription
mercredi 21 août 2002
Statut
Contributeur
Dernière intervention
7 janvier 2019
 -
c possible une version sans FSO ? parce que serieusement FSO ...
Signaler
cs_jds
Messages postés
8
Date d'inscription
mardi 17 décembre 2002
Statut
Membre
Dernière intervention
26 novembre 2004
 -
Salut les gars, désolé j'ai corrigé quelques bug et ajouté le projet avec la MDB
Signaler
zeunz
Messages postés
201
Date d'inscription
jeudi 26 février 2004
Statut
Membre
Dernière intervention
30 juin 2008
 -
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.