توقف البرنامج عن العمل، بالرغم من سلامة عمله!

[Mohammed-Saeed 33]

لدي حوالي مليون صورة ... بعضها تالف حين التحميل ...

قمت ببرمجة بريمج، لفحص هذه الصور، وتخزين النتيجة في قاعدة بيانات .. ولكن المشكلة ان البرنامج يتوقف عن العمل بعد فحص حوالي 200-300 صورة ..

الكود كالتالي:

Set DB = SetDatabase(App.path & "\Pics.mdb")
Set RS = SetRecordset("Pics_Check", DB)
RS.MoveFirst
Pics_Path$ = "L:\Pics\"
DoEvents
For i = 1 To RS.RecordCount
    IMG_Path$ =Pics_Path$ & RS("File").Value & "\" & RS("Pic_name").Value
    RS("GoodPic").Value = isGoodPicture(IMG_Path$)
    RS("Exist").Value = True
    RS.Update
    RS.MoveNext
Next i

MsgBox "OK"

وكود دالة فحص الصور كالتالي:

Public Function isGoodPicture(ByVal PicPath As String) As Boolean
On Error Resume Next
    Dim pic As StdPicture
    Set pic = LoadPicture(PicPath)

    If Err = 0 Then isGoodPicture = True
    Set pic = Nothing
End Function

والمطلوب، حل مشكلة توقف البرنامج عن العمل ..

* الصورة التالية تبين مقادير استهلاك الذاكرة والمعالج ... ولا اشعر باي مشكلة في تشغيل سائر البرامج

للاتصال بقاعدة البيانات استخدم هذه في موديول

Public DB As Connection

Public Function SetDatabase(ByVal DBFileName As String, Optional ConnectionString As String = "MDB", Optional DBPassword As String = "") As Connection
    Dim mDB As New Connection
    Select Case ConnectionString
        Case "MDB"
            If DBPassword <> "" Then DBPassword = "pwd=" & DBPassword & ";"
            ConnectionString = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & DBFileName & ";" & DBPassword

    'y = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBFileName & ";"

    End Select

    mDB.CursorLocation = adUseClient
    mDB.Mode = adModeReadWrite

    mDB.Open ConnectionString

Set SetDatabase = mDB
End Function
Public Function SetRecordset(ByVal RecordSource As String, ByVal DBase As Connection) As Recordset
Set SetRecordset = Nothing
Dim RS As New Recordset 'adOpenDynamic
RS.Open RecordSource, DBase, adOpenDynamic, adLockOptimistic
Set SetRecordset = RS
End Function

تحياتي

تم تعديل 25 Jan 2011 بواسطه Mohammed-Saeed

[najy_zl 122]

السلام عليكم...

مبدئياً: انقل DoEvents إلى داخل الحلقة (بعد RS.MoveNext) لأن فائدة DoEvents تكون داخل الحلقة و ليس خارجها. ثم جرب التشغيل مرة أخرى.

ثانياً: ماذا تقصد بـ "يتوقف عن العمل" ؟ هل يمتنع عن الاستجابة؟ أم يعطي رسالة خطأ عند سطر معين؟ أم يكمل الحلقة لكنه لا يتعامل مع كل الملفات؟

نرجو التوضيح و السلام.

[Mohammed-Saeed 33]

شكرا جزيلا لك ...

البرنامج يمتنع عن الاستجابة ... ساععود غدا للمنزل، حقيقة، كما تقول اخطات في ممكان الـ doevents

ولم انتظر لاعرف ما يجري ... لان عدد الصور مليون و300 الف صورة ...

[Mohammed-Saeed 33]

السلام عليكم

كما قلت سابقا، البرنامج يمتنع عن الاستجابة

ولكن، ارتفع عدد الملفات التي يعالجها من 200 الى حوالي 700 !!!

ولم تتغير سائر المعطيات ...

[kemas 32]

ممكن شرح لفائدة

doevents