منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب - امل المساعده في ضغط و إصلاح قاعدة البيانات

السلام عليكم و رحمة الله Smile

امل المساعده Wink

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

1 . البرنامج يستخدم على الشبكة

2 . قاعدة البيانات بدون رقم سري

3 . هل يجب قفل قاعدة البيانات قبل العملية

ملاحظة الربط في البرنامج عن طريق الاداة Adodc

Shy

امل المساعده

(14-06-14, 01:19 AM)allayl كتب : [ -> ]...
ضغط و إصلاح قاعدة البيانات
...

.....

منقول مع تعديل بسيط ليناسب طلبك

بنظام ADO
أضف المرجع Reference التالي: Microsoft Jet and Replication Objects 2.6 Labrary أو آخر إصدار لديك
طريقة إضافة المرجع Reference عن طريقة القائمة Project ثم ...References ثم اختيار المرجع

كود :

Private Sub Command1_Click()

    If DAOCompactDatabase("db1.mdb", "") Then

        MsgBox "تم ضغط وإصلاح قاعدة البيانات بنجاح"

    End If

End Sub

' أضف المرجع: Microsoft Jet and Replication Objects 2.6 Labrary ' أو آخر إصدار لديك

Private Function ADOCompactDatabase(filename As String, Optional password As String) As Boolean

On Error GoTo ExceptionHandle

    Const Provider = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="

    Const JetVersion = ";Jet OLEDB:Engine Type=5"

    Dim JRO As JetEngine

    Dim strPassword As String

    Dim strTemp As String

    strTemp = Left(filename, InStrRev(filename, "\")) & "Compact.mdb"

    If Len(Dir(strTemp)) <> 0 Then Kill strTemp

    If Len(password) <> 0 Then strPassword = ";Jet OLEDB:Database Password=" & password

    Set JRO = New JetEngine

    JRO.CompactDatabase Provider & filename & strPassword, Provider & strTemp & JetVersion & strPassword

    Set JRO = Nothing

    Kill filename

    Name strTemp As filename

    ADOCompactDatabase = True

    Exit Function

ExceptionHandle:

    MsgBox Err.Description, vbInformation

End Function

بنظام DAO
أضف المرجع Reference التالي: Microsoft DAO 3.6 Object Library أو آخر إصدار لديك
طريقة إضافة المرجع Reference عن طريقة القائمة Project ثم ...References ثم اختيار المرجع

كود :

Private Sub Command1_Click()

    If DAOCompactDatabase("db1.mdb", "") Then

        MsgBox "تم ضغط وإصلاح قاعدة البيانات بنجاح"

    End If

End Sub

' أضف المرجع: Microsoft DAO 3.6 Object Library ' أو آخر إصدار لديك

Public Function DAOCompactDatabase(filename As String, Optional password As String) As Boolean

On Error GoTo ExceptionHandle

    Dim strTemp As String

    strTemp = Left(filename, InStrRev(filename, "\")) & "Compact.mdb"

    If Len(Dir(strTemp)) <> 0 Then Kill strTemp

    If Len(password) <> 0 Then

        DBEngine.CompactDatabase filename, strTemp, ";pwd=" & password, , ";pwd=" & password

    Else

        DBEngine.CompactDatabase filename, strTemp

    End If

    Kill filename

    Name strTemp As filename

    DAOCompactDatabase = True

    Exit Function

ExceptionHandle:

    MsgBox Err.Description, vbInformation

End Function

.....

شكرآ اخي vbnet بارك الله فيك