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

+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم قواعد البيانات (http://vb4arb.com/vb/forumdisplay.php?fid=40)
+--- قسم : قسم اسئلة vb6.0 المتعلقة بقواعد البيانات (http://vb4arb.com/vb/forumdisplay.php?fid=72)
+--- الموضوع : [سؤال] امل المساعده في ضغط و إصلاح قاعدة البيانات (/showthread.php?tid=3182)

امل المساعده في ضغط و إصلاح قاعدة البيانات - allayl - 14-06-14

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

WinkWinkWink امل المساعده WinkWinkWink

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

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

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

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

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

ShyShyShy امل المساعده


RE: امل المساعده في ضغط و إصلاح قاعدة البيانات - vbnet - 14-06-14

(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

.....

RE: امل المساعده في ضغط و إصلاح قاعدة البيانات - allayl - 18-06-14

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