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

up

up

up

Up

>>>>>>>>>>>>>>>>

وعليكم السلام اخي :)

رجاء مراجعة الرابط التالي للحصول على اسم برنامج الجداول المقسم:

/index.php/topic/293420-نسخ-احتياطي-لقاعدة-البيانات/?p=1399191

اما ملاحظتك بعدم استخدام الضغط بكثرة حتى لا يحدث ضرر بالقاعدة ، فهذه المعلومة غير دقيقة ، ففي معظم الاوقات نستخدم الضغط والاصلاح التلقائي عند اغلاق البرنامج ، للبرنامج الذي به النماذج والجداول ، وللبرامج المقسمة (اي نضغط البرنامج الواجهة والبرنامج الذي يحتوي على الجداول)

نعم هناك مشكلة الضغط والاصلاح في الاصدار الاول للاكسس 2007 ، مما كان يضر بالقاعدة ، ولكنه تم تصليح هذا لاحقا :)

جعفر

شكرا اخي جعفر

على اجابتك

حاولت جاهداً  الاستئناس بالكود الذي تفضلت به حضرتك

المتعلق بالمشاركة تحت عنوان  "نسخ قاعدة البيانات"

والحمد لله، وصلت الى نتيجة 90 %

من خلال تعديل كود الضغط

ولكن بقيت لدي مشكلة لم استطع حلها ( نظراً الى كون الكود المتعلق بالضغط وهو الكود المأخوذ من الاخت زهرة جزاها الله عنا كل خير معقد ) .

والمشكلة تتمثل في ان البرنامج لا يعود يفتح تلقائياً، بعد ان اضغط على زر استمرار

ولكن عوضاً عن ذلك،  تفتح القاعدة التي بها الجداول

ارجو تصويب الكود الموجود بالوحدة النمطية

تحت عنوان  Restart

Public Sub Restart(Optional Compact As Boolean = True)
    Dim scriptpath As String
    Dim x, xx1  As String
    Dim falg_x As Boolean
    
    falg_x = False
    Call BE_or_FE
    x = Mid(DBEngine.Workspaces(0).Databases(0).TableDefs("beda").Connect, 11)
    
   'ÚäÏ ÊÍÞÞ ÇáÔÑØ Êßæä ÇáÌÏÇæá Öãä ÞÇÚÏÉ ÇáÈíÇäÇÊ æáíÓÊ ãäÝÕáÉ
    If Len(x & "") = 0 Then
        x = Application.CurrentProject.Name
        falg_x = True
    End If
    
    If falg_x = True Then
         scriptpath = Application.CurrentProject.FullName & ".dbrestart.bat"
         xx1 = CurrentProject.FullName
    Else
        scriptpath = x & ".dbrestart.bat"
        xx1 = x
    End If
    
    
    
    If Dir(scriptpath, vbNormal) <> "" Then
        If DateAdd("s", TIMEOUT * 2, FileDateTime(scriptpath)) < Date Then
            Kill scriptpath
        Else
            Application.Quit acQuitSaveAll
            Exit Sub
        End If
    End If
    
    Dim s As String
    s = s & "SETLOCAL ENABLEDELAYEDEXPANSION" & vbCrLf
    s = s & "SET /a counter=0" & vbCrLf
    s = s & ":CHECKLOCKFILE" & vbCrLf
    s = s & "ping 0.0.0.255 -n 1 -w 100 > nul" & vbCrLf
    s = s & "SET /a counter+=1" & vbCrLf
    s = s & "IF ""!counter!""==""" & TIMEOUT & """ GOTO CLEANUP" & vbCrLf
    s = s & "IF EXIST ""%~f2.%4"" GOTO CHECKLOCKFILE" & vbCrLf
    If Compact Then
        s = s & """%~f1"" ""%~f2.%3"" /compact" & vbCrLf
    End If
    s = s & "start "" "" ""%~f2.%3""" & vbCrLf
    s = s & ":CLEANUP" & vbCrLf
    s = s & "del %0"
    
    Dim intFile As Integer
    intFile = FreeFile()
    Open scriptpath For Output As #intFile
    Print #intFile, s
    Close #intFile
    
    Dim dbname As String, ext As String, lockext As String, accesspath As String
    Dim idx As Integer
    
    accesspath = SysCmd(acSysCmdAccessDir) & "msaccess.exe"
   
   
    For idx = Len(xx1) To 1 Step -1
        If Mid(xx1, idx, 1) = "." Then Exit For
    Next idx
    dbname = Left(xx1, idx - 1)
    ext = Mid(xx1, idx + 1)
    
    If Left(ext, 2) = "ac" Then
        lockext = "laccdb"
    Else
        lockext = "ldb"
    End If
    
   ' scriptpath = Application.CurrentProject.FullName & ".dbrestart.bat"
    
    s = """" & scriptpath & """ """ & accesspath & """ """ & dbname & """ " & ext & " " & lockext
    Shell s, vbHide
    
   Application.Quit acQuitSaveAll
End Sub

يحيث يصبح المثال المرفق، مشابه في ادائه للمثال

Q103

او اذا كان هناك كود ابسط لضغط قاعدة البيانات واصلاحها اسهل، التكرم به

والف شكر

Q104 up.rar

وعليكم السلام اخي :)

في الوحدة النمطية اعلاه ، غير السطر التالي:

s = s & "start "" "" ""%~f2.%3""" & vbCrLf

الى

s = s & "start "" "" " & Application.CurrentProject.FullName & vbCrLf

:)

جعفر

الف شكر

اخي جعفر

على الارشاد الى مكمن الخطأ

الحمد لله نجح الامر، مائة بالمائة واصبح المثال شغال

واحببت ان اضع المثال من جديد بعد التعديل، لتعم الفائدة على الجميع

اخي جعفر

هل يكفي تطبيق الكود على القاعدة التي بها الجداول

ام انني بحاجة ايضا الى تطبيق الكود كذلك على القاعدة الاساسية  التي بداخلها ( الاستعلامات- النماذج - التقارير - الوحدات النمطية )

ارجو التوضيح

والف شكر

xx.rar

هلا والله ، عمل جميل :)

نعم ، انا افضل لو انه بالإمكان ان يتم العمل على الجزئين ، حيث اني في احد مشاركاتي سابقا في بعض المواقع الاجنبية ، كبر حجم برنامج الواجهة FE ، كبر حجمه من 36 ميجا الى اكثر من 200 ميجا واصبح بطيئا ،

وعند عمل الضغط تلقائيا (عند الخروج من البرنامج) ، رجع حجمه وسرعته كما يفترض :)

وللعلم ، حتى البرامج المقفلة mde مثلا ، تحتاج الى الضغط :)

جعفر

شكرا اخي جعفر

على تواصلك معي

بعد نقل الكود الى برنامجي الاساسي، ظهر معي خطأ ..........

واخذ الامر معي وقتا طويلاً الى ان عرفت السبب

الخطأ يظهر،  عندما يكون هناك فراغ في اسم قاعدة البيانات الاساسية

كأن يكون الاسم Q 105، عندئد تظهر مشكلة بالبرنامج

اما اذا كان الاسم لا يحتوي على فراغ كأن يكون Q105 فعندئد الامور عال العال

من خلال تتبع التنفيذ

وجدت ان الخطأ يحدث عن الوصول الى

If Dir(scriptpath, vbNormal) <> "" Then
        If DateAdd("s", TIMEOUT * 2, FileDateTime(scriptpath)) < Date Then
            Kill scriptpath
        Else
            Application.Quit acQuitSaveAll
            Exit Sub
        End If
    End If

ارجو المساعدة في تصحيح الكود، وخاصة هناك احتمال كبير بأن يقوم المستثمر بتسمية الملف الاساسي متضمن فراغ كأن يكتب

Kafi 2014

or

kafi factory 2014

والف شكر

Q 105.rar

وعليكم السلام اخي :)

اذا كان الخطأ في الكودد الذي ارفقته ، فغير هذا السطر:

Kill scriptpath

الى

Kill chr(34) & scriptpath & chr(34)

جعفر

السلام عليكم

اخي جعفر

تم تعديل الكود كما اشرت اليه

ولكن مازالت المشكلة قائمة

ارجو المساعدة في تصويب الكود

والف شكر

xx.rar

وعليكم السلام اخي :)

الخطأ لم يكن في السطر الذي ذكرت ، وانما في السطر الذي غيرناه سابقا :)

غير السطر التالي:

    s = s & "start "" "" " &  Application.CurrentProject.FullName &  vbCrLf

الى:

    s = s & "start "" "" " & Chr(34) & Application.CurrentProject.FullName & Chr(34) & vbCrLf

جعفر

306.1.Q 105.zip

الف شكر

اخي جعفر

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

نجح الامر اخيرا

والحمد لله

:)