• 0
Mohammed-Saeed

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

سؤال

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

قمت ببرمجة بريمج، لفحص هذه الصور، وتخزين النتيجة في قاعدة بيانات .. ولكن المشكلة ان البرنامج يتوقف عن العمل بعد فحص حوالي 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

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

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

post-4086-033594700 1295900868_thumb.jpg

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

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

تحياتي

تم تعديل بواسطه Mohammed-Saeed
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

4 إجابة على هذا السؤال .

  • 0

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

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

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

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

1

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

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

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

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

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

السلام عليكم

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

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

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

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

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

doevents

 

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

  • يستعرض القسم حالياً   0 members

    لا يوجد أعضاء مسجلين يشاهدون هذه الصفحة .