مشكلة بصراحة عجزت احلها عند العميل

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

نتمنى أن نساعدك و لكم من الصعب ذلك و نحن لا نرى البرنامج أو الكود و قاعدة البيانات. الرسالة المذكورة تظهر مع عدة مكونات (مكونات ADO مثلاً) و تحتاج إلى تتبع.

على أية حال - و كاقتراح فقط - ضع برنامجك في جهازك تحت نفس ظروف البرنامج لدى العميل، أي ضع نسخة من البرنامج في مسار مطابق لمسار البرنامج لدى العميل، و انسخ قاعدة البيانات و أية ملفات أخرى يستعملها برنامجك من جهاز العميل إلى جهازك، ثم قم بتتبع عمل البرنامج (Break Points و Debug).

من ناحية أخرى، ليس بالضرورة أن تكون المشكلة في الـ Form نفسها. قد تكون المشكلة في مكان آخر (Module مثلاً) و تلك الـ Form تستعمل ذلك الكود البعيد.

نرجو الاستفادة و السلام.

اولا شكرا على اقتراحك اخي الكريم ناجي

تم عمل الاقتراح اخي ناجي ولكن مافي فايدة ارجو مساعدتك ومن الاخرين ايضا

للمعلومية قاعدة البيانات sql 2000 والبرنامج يعمل على شبكة محلية

اللي خلاني اعجز عن حل هالمشكلة انو ال exe الاول اللي جاي مع السيتب شغال زي الحلاوة كل اللي عملتو رحت عدلت في فورم تاني غير الفورم اللي تطلع فيه الرسالة عند الحفظ يعني تعديل بسيط جدا ورحت عشان احط ال exe بدلا من الاول صارت تطلع هذه الرسالة والمشكلة كمان انها ماتطلع بالكود

هل الانتي فايروس له تأثير في الموضوع؟

ولا الصلاحيات الجهاز على الشبكة ؟

او في اسباب اخرى؟

مثل ما قال أخي المشرف Najy_zl صعب نعرف المشكلة من دون ما ترفع الكود ...

بس الواضح من الرسالة حسب توقعي - مجرد توقع ..

يوجد لديك recordset معرف لنفترض أنه RE فأنت تقوم بإضافة بيانات في ذلك المعرف (الجدول) ومن ثم نسيت عمل RE.Update ثم تقوم بفتح الجدول أو محاولة إغلاقه ....

أنصحك بتثبيت الفيجوال بيسك وأي أدوات أخرى في جهاز العميل ومحاولة اكتشاف الخطأ هناك .....

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

ربما نستطيع مساعدتك إذا وضعت لنا على الأقل كود الحفظ كما هو عندك تماماً.

و السلام.

هذا هو كود زر الحفظ من خلاله يمكن حفظ وتعديل الفاتورة ويحتوي ايضا على Functions فرعية قمت بذكر الكود الخاص بها حتى تتضح جميع الجوانب

Private Sub cmdsave_Click()
	On Error GoTo errsave
	Dim p As Integer
	Dim rs As New ADODB.Recordset
	Dim rsd As New ADODB.Recordset
	Dim rsU As New ADODB.Recordset
	Dim rsinvu As New ADODB.Recordset
	Dim rsdemo As New ADODB.Recordset
	Dim C1 As Integer
	Dim strProb As String
	'Demo Version ---------------------------------
	rsdemo.Open "select count(invoiceid)as RCount from t_maintinfo_h", Con, adOpenDynamic, adLockOptimistic
	If rsdemo.EOF = False Then
		If rsdemo.Fields!RCount >= 750 Then
			Reply = ShowMessage("Demo Version finished Please Register it", "Unregistered Version!", True, False, False, False)
			End
		End If
	End If
rsdemo.close


	If CustName.Text = "" Then
		CustName.SetFocus
		Exit Sub
	End If

	If Tel.Text = "" Then
		Tel.SetFocus
		Exit Sub
	End If

	If serialNo.Text = "" Then
		serialNo.SetFocus
		Exit Sub
	End If

	If Companies.Text = "" Then
		Companies.SetFocus
		Exit Sub
	End If
	If models.Text = "" Then
		models.SetFocus
		Exit Sub
	End If

	If TechName.Text = "" Then
		TechName.SetFocus
		Exit Sub
	End If


	For I = 1 To lvprob.ListItems.Count
		If lvprob.ListItems(I).Checked = True Then
			c = c + 1
		End If
	Next

	If c = 0 Then
		Reply = ShowMessage("Select Problems", "Data Save", True, False, False, False)
		Exit Sub
	End If


	C1 = 0
	strProb = ""
	For I = 1 To lvprob.ListItems.Count
		If lvprob.ListItems(I).Checked = True Then
			C1 = C1 + 1
			If strProb = "" Then
				strProb = lvprob.ListItems(I).Text & "-" & C1
			Else
				strProb = strProb & vbNewLine & lvprob.ListItems(I).Text & "-" & C1
			End If
		End If
	Next


	rs.Open "select * from t_maintinfo_h where invoiceid='" & lblinvoice.Caption & "' and branchid='" & gsBranchId & "'", Con, adOpenDynamic, adLockOptimistic
	If rs.EOF = False Then	'Edit
		rsU.Open "select * from t_usersaccessrights where userid='" & gsUserId & "' and screenName='" & gsMenuName & "'", Con, adOpenDynamic, adLockOptimistic
		If rsU.EOF = False Then
			If rsU.Fields!editBtn = "1" Then

				sql = "select u.Username,u.userid from t_users U inner join t_maintinfo_h  mainth on u.userid=mainth.userid where mainth.invoiceid='" & lblinvoice.Caption & "' and branchid='" & gsBranchId & "'"
				rsinvu.Open sql, Con, adOpenDynamic, adLockOptimistic
				If rsinvu.EOF = False Then
					If gsUserId = rsinvu.Fields!Userid Then
						rs.Fields!custid = Tel.Text
						rs.Fields!TechID = gsTechID
						rs.Fields!MobCompany = Companies.Text
						rs.Fields!Mobmodel = models.Text
						rs.Fields!mobserialNo = serialNo.Text
						rs.Fields!initcost = InitValue.Text
						rs.Fields!FinalCost = 0
						rs.Fields!notices = notices.Text
						rs.Update
					   Reply = ShowMessage("Invoice Updated Successfuly !!!", "Data UPDATE", True, False, False, False)
						cmdprint_Click
						CleanBoxes Me
						Me.lblfinalcost.Caption = ""
						Me.lblFinalReply.Caption = "'"
						Me.lblGEnDate.Caption = ""
						Me.lblGStatus.Caption = ""
						Me.lblTechReport.Caption = ""
						frmInvoice.lblDeliverstatus.Caption = ""

						DisableTextBoxes Me
						Loadproblems
						cmdnew.Enabled = True
						cmdsave.Enabled = False
						cmddelete.Enabled = False

					Else
						Reply = ShowMessage("This Invoice Made By " & rsinvu.Fields!UserName, "Permission", True, False, False, False)
						rsinvu.Close
						rs.Close
						rsU.Close
						Exit Sub
					End If

				End If
				rsinvu.Close

			Else
				Reply = ShowMessage("You have no permission", "Permissions", True, False, False, False)
				rsU.Close
				rs.Close
				Exit Sub
			End If
		Else
			If LCase(gsUserType) = "supervisor" Then
				rs.Fields!custid = Tel.Text
				rs.Fields!TechID = gsTechID
				rs.Fields!MobCompany = Companies.Text
				rs.Fields!Mobmodel = models.Text
				rs.Fields!mobserialNo = serialNo.Text
				rs.Fields!initcost = InitValue.Text
				rs.Fields!FinalCost = 0
				rs.Fields!notices = notices.Text
				rs.Update

				Reply = ShowMessage("Invoice Updated Successfuly !!!", "Data UPDATE", True, False, False, False)
				cmdprint_Click
				CleanBoxes Me
				Me.lblfinalcost.Caption = ""
				Me.lblFinalReply.Caption = "'"
				Me.lblGEnDate.Caption = ""
				Me.lblGStatus.Caption = ""
				Me.lblTechReport.Caption = ""
				frmInvoice.lblDeliverstatus.Caption = ""
				DisableTextBoxes Me
				Loadproblems
				cmdnew.Enabled = True
				cmdsave.Enabled = False
				cmddelete.Enabled = False


			End If
		End If
		rsU.Close



	Else		   'Save
		rs.AddNew
		rs.Fields!invoiceid = lblinvoice.Caption
		rs.Fields!invoicedate = Format(Date, "dd/mm/yyyy")
		rs.Fields!InvoiceTime = Format(Time, "hh:nn:ss AMPM")
		rs.Fields!CounterID = gsCounterNo
		rs.Fields!branchid = gsBranchId
		rs.Fields!custid = Tel.Text
		rs.Fields!Userid = gsUserId
		rs.Fields!TechID = gsTechID
		rs.Fields!MobCompany = Companies.Text
		rs.Fields!Mobmodel = models.Text
		rs.Fields!mobserialNo = serialNo.Text
		rs.Fields!problems = strProb
		rs.Fields!CurMobStatus = 5	'not yet checked
		rs.Fields!guranteeID = 3	'No Gurantee
		If InitValue.Text = "" Then InitValue.Text = "0.00"
		rs.Fields!initcost = InitValue.Text
		rs.Fields!FinalCost = 0
		rs.Fields!notices = notices.Text
		rs.Update

p = 0
		rsd.Open "select * from t_maintinfo_d", Con, adOpenDynamic, adLockOptimistic
		For I = 1 To lvprob.ListItems.Count
			If lvprob.ListItems(I).Checked = True Then
				p = p + 1
				rsd.AddNew
				rsd.Fields!invoiceid = lblinvoice.Caption
				rsd.Fields!ProbLineNo = p
				rsd.Fields!branchid = gsBranchId
				rsd.Fields!Userid = gsUserId
				rsd.Fields!TechID = gsTechID
				rsd.Fields!ProblemId = lvprob.ListItems(I).Tag
				rsd.Update

			End If
		Next
		rsd.Close

		If blnCustExist = False Then
		 Con.Execute ("INSERT INTO T_CUSTOMERS (CUSTNAME,CUSTTEL) VALUES('" & CustName.Text & "','" & Tel.Text & "')")
		End If

		Call SaveNextNumber(gsCounterNo)

		cmdnew.Enabled = True
		cmdsave.Enabled = False
		cmddelete.Enabled = False

		Reply = ShowMessage("Invoice Saved Successfuly !!!", "Data Save", True, False, False, False)

		cmdprint_Click



		CleanBoxes Me
		DisableTextBoxes Me
		Loadproblems
	End If
	rs.Close

	Exit Sub
errsave:
	If rs.State = adStateOpen Then rs.Close
	If rsU.State = adStateOpen Then rsU.Close
	If rsinvu.State = adStateOpen Then rsinvu.Close
	Reply = ShowMessage(err.Description, "Error Save!", True, False, False, False)
End Sub




Public Sub SaveNextNumber(scounter As String)
On Error GoTo err
	Dim rsn As New ADODB.Recordset
	rsn.Open "select * from t_counters where counter='" & scounter & "'", Con, adOpenDynamic, adLockOptimistic
	If rsn.EOF = False Then
		rsn.Fields("NextNumber").Value = Val(rsn.Fields("NextNumber").Value) + 1
		rsn.Update
	End If
	rsn.Close
Exit Sub
err:
Reply = ShowMessage(err.Description, "Error !!", True, False, False, False)
end sub



Sub Loadproblems()
	On Error GoTo err
	Dim rs1 As New ADODB.Recordset
	Dim Y As ListItem
	lvprob.ListItems.Clear
	rs1.Open "select  * from t_mobproblems", Con, adOpenDynamic, adLockOptimistic
	Do Until rs1.EOF
		Set Y = lvprob.ListItems.Add(, , rs1.Fields!MobProblemName)
		Y.Tag = rs1.Fields!ProblemId
		rs1.MoveNext
	Loop
	rs1.Close



	Exit Sub
err:
	Reply = ShowMessage(err.Description, "Error !!", True, False, False, False)

End Sub

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

الخطأ القاتل الذي يؤدي إلى إنهاء البرنامج يقع ضمن الـ Error Handler نفسه !!!

قبل ذلك هناك خطأ ما يحدث ضمن كود الحفظ أثناء إضافة أو تعديل سجل. و بسبب وجود الـ Error Handler فإن التنفيذ سينتقل إلى الوسم errsave و عند تنفيذه لإحدى جمل Close الثلاث (المرافقة للـ Recordset الجاري إضافة أو تعديل سجل فيها) يحدث الخطأ و يقفل البرنامج.

تقول تعليمات ADO أنه إذا استعملنا Close مع Recordset يجري إضافة أو تعديل سجل فيها حالياً فإن هذا الأمر سيتسبب في خطأ. و لتتأكد بنفسك عدل ترتيب أسطر الـ Error Handler كالتالي:

أي ضع الرسالة أولاً. في هذه الحالة سيعطيك رسالة الخطأ الفعلية، ثم سيعطيك رسالة "Operation is not allowed in this context" و يغلق البرنامج (لأنه لم تتم معالجة هذا الخطأ الثاني).

الحل:

قبل إغلاق الـ Recordsets الثلاث تأكد من أنها ليست في حالة إضافة أو تعديل (باختبار الخاصية EditMode). سيصبح الـ Error Handler هكذا:

نرجو الاستفادة و السلام.

الله يعطيك العافية اخي ناجي عذبتك معاي و اللي شارك بالحل

بالفعل اخي ناجي كلامك صح مية مية واكتشفت الخطأ عند العميل حيث وضعت الكود وقمت بالتتبع .واكتشفت انو سبب هذه الرسالة هو من الerror handler عند اول جملة

if rs.state=adstateopen then rs.close

ولكن كان هناك مسبب للerror وهو عند الجملة التالية

rs.Fields!problems = strProb

وهي ليست السبب الرئيسي انما السبب طلع في في حجم ونوع بيانات الحقل Problems في قاعدة البيانات.انا كنت حاطه عند العميل يدويا من السرعة من نوع char وهذا الحقل عادة يحمل قيمة اكير من 256 حرف .وقمت بتغييره وكل شي تمام الحمد لله الان .

اتمنى لك التوفيق اخي ناجي