ضغط و اصلاح قاعدة البيانات

-09

الاخ الفاضل :: YasserSayed2003

هناك فرق كبير بين الـ dao و الـ ado

ففى الـ dao يمكنك ان تقم بعملية " ضغط و اصلاح قاعدة البيانات " من خلال نفس الـ dll

و لكن لكى تقم بعمل هذا فى الـ ado يجب ان تقم بارفاق الملف الاتى هذا الملف :

Microsoft Jet and Replication Objects 2.5 Library

بعد هذا تقم باستخدام الكود الاتى :

strFileName = "C:\WINDOWS\SYSTEM\gcdb.mdb"
strBackup = "C:\WINDOWS\SYSTEM\backup.mdb"
CompactDB strFileName, strBackup

و ترفق المديول الخاص بالعملية ( بهذ المديول يمكنك من تغير كلمة السر و اشاء اخرى و لك التجربة )

Option Explicit
' Set a reference to the Microsoft Jet and Replication Objects 2.1

Public Function EncryptDB(ByRef SourceDB As String, _
                          ByRef DestDB As String, _
                          ByRef Pswd As String) As Boolean
On Error GoTo ErrHandler

    Dim JRO         As JRO.JetEngine
    Dim SourceCnn   As String
    Dim DestCnn     As String
     
    Set JRO = New JRO.JetEngine
    
    ' Kill the backup if it currently exists
    If Dir(DestDB) <> vbNullString Then Kill DestDB
    
    ' Build the SourceConnection ConnectionString
    SourceCnn = "Provider=Microsoft.Jet.OLEDB.4.0" & _
                ";Data Source=" & SourceDB & _
                ";Jet OLEDB:Database Password=" & Pswd
    
    ' Build the DestConnection ConnectionString
    DestCnn = "Provider=Microsoft.Jet.OLEDB.4.0" & _
              ";Data Source=" & DestDB & _
              ";Jet OLEDB:Database Password=" & Pswd & _
              ";Jet OLEDB:Engine Type=5" & _
              ";Jet OLEDB:Encrypt Database=True"
        
    ' Create a compacted and encrypted replica
    JRO.CompactDatabase SourceCnn, DestCnn
        
    ' Kill the original and rename the replica
    Kill SourceDB
    Name DestDB As SourceDB
    EncryptDB = True
    
ErrHandler:
    Set JRO = Nothing
    
    If Err.Number <> 0 Then
        EncryptDB = False
        Err.Raise Err.Number, Err.Source, Err.Description
    End If
End Function

Public Function CompactDB(ByRef SourceDB As String, _
                          ByRef DestDB As String, _
                          Optional ByRef Pswd As String = "") As Boolean
On Error GoTo ErrHandler

    Dim JRO         As JRO.JetEngine
    Dim SourceCnn   As String
    Dim DestCnn     As String
     
    Set JRO = New JRO.JetEngine
    
    ' Kill the backup file if it currently exists
    If Dir(DestDB) <> vbNullString Then Kill DestDB
     
    ' Build the SourceConnection ConnectionString
    SourceCnn = "Provider=Microsoft.Jet.OLEDB.4.0" & _
                ";Data Source=" & SourceDB & _
                ";Jet OLEDB:Database Password=" & Pswd
    
    ' Build the DestConnection ConnectionString
    DestCnn = "Provider=Microsoft.Jet.OLEDB.4.0" & _
              ";Data Source=" & DestDB & _
              ";Jet OLEDB:Engine Type=5" & _
              ";Jet OLEDB:Database Password=" & Pswd
    
    ' Create a compacted replica
    JRO.CompactDatabase SourceCnn, DestCnn
    
    ' Kill the original and rename the replica
    Kill SourceDB
    Name DestDB As SourceDB
    CompactDB = True
    
ErrHandler:
    Set JRO = Nothing
    
    If Err.Number <> 0 Then
        CompactDB = False
        Err.Raise Err.Number, Err.Source, Err.Description
    End If
End Function

Public Function ChangePassword(ByRef SourceDB As String, _
                               ByRef DestDB As String, _
                               ByRef OldPswd As String, _
                               ByRef NewPswd As String) As Boolean
On Error GoTo ErrHandler

    Dim JRO         As JRO.JetEngine
    Dim SourceCnn   As String
    Dim DestCnn     As String
     
    Set JRO = New JRO.JetEngine
    
    ' Kill the backup file if it currently exists
    If Dir(DestDB) <> vbNullString Then Kill DestDB
     
    ' Build the SourceConnection ConnectionString
    SourceCnn = "Provider=Microsoft.Jet.OLEDB.4.0" & _
                ";Data Source=" & SourceDB & _
                ";Jet OLEDB:Database Password=" & OldPswd
     
    ' Build the DestConnection ConnectionString
    DestCnn = "Provider=Microsoft.Jet.OLEDB.4.0" & _
              ";Data Source=" & DestDB & _
              ";Jet OLEDB:Engine Type=5" & _
              ";Jet OLEDB:Database Password=" & NewPswd
    
    ' Create replica with new password
    JRO.CompactDatabase SourceCnn, DestCnn
    
    ' Kill the original and rename the replica
    Kill SourceDB
    Name DestDB As SourceDB
    ChangePassword = True
    
ErrHandler:
    Set JRO = Nothing
    
    If Err.Number <> 0 Then
        ChangePassword = False
        Err.Raise Err.Number, Err.Source, Err.Description
    End If
End Function

Public Function AddBackslash(strPath As String) As String
'Add backslash to the AppPath string
On Error Resume Next
    
    If Right$(strPath, 1) <> "\" Then
        AddBackslash = strPath & "\"
    Else
        AddBackslash = strPath
    End If
    
End Function

و الله الموفق

شرحا جميل ووافي اخي codefinder

جزاكم الله خيرا

سأقوم بتجريب البرنامج و أخبرك بالنتيجة