ابو جودي

ههههههههههههه يخلق من الشبه 40 مش عارف شوفت بعض الافكار فين بس برافو تطبيق رائع

يمكن وضعه كنموذج فرعى داخل اى نموذج وسوف يعمل على الفور بدون ادنى تدخل الاكواد التى تمت كتابتها لهذا العمل Option Compare Database Option Explicit Private mHostForm As Access.Form Private mRecordCount As Long Private mIsInitialized As Boolean Private mLastPosition As Long Private mLastCount As Long Private mLastIsNew As Boolean Private mHasLastState As Boolean Private Sub Form_Load() InitializeNavigator End Sub Private Sub InitializeNavigator() If Not EnsureHostForm Then Exit Sub RefreshRecordCount True With mHostForm.Recordset If Not (.BOF And .EOF) Then .MoveFirst End With UpdateUI mIsInitialized = True End Sub Private Sub Form_Current() If mIsInitialized Then UpdateUI End Sub Private Function EnsureHostForm() As Boolean On Error GoTo ErrorHandler If mHostForm Is Nothing Then If TypeOf Me.Parent Is Form Then Set mHostForm = Me.Parent End If ExitFunction: EnsureHostForm = Not (mHostForm Is Nothing) Exit Function ErrorHandler: Set mHostForm = Nothing Resume ExitFunction End Function Private Function HasRecords() As Boolean HasRecords = (mRecordCount > 0) End Function Private Sub RefreshRecordCount(Optional ByVal force As Boolean = False) On Error GoTo ErrorHandler If Not EnsureHostForm Then mRecordCount = 0 Exit Sub End If If Not force Then If mRecordCount > 0 Then Exit Sub End If With mHostForm.RecordsetClone If .BOF And .EOF Then mRecordCount = 0 Else .MoveLast mRecordCount = .recordCount End If End With ErrorHandler: End Sub Private Function GetCurrentPosition() As Long On Error GoTo ErrorHandler If Not EnsureHostForm Then GetCurrentPosition = 0 ElseIf mRecordCount <= 0 Then GetCurrentPosition = 0 ElseIf mHostForm.NewRecord Then GetCurrentPosition = mRecordCount + 1 Else Dim pos As Long pos = mHostForm.CurrentRecord If pos <= 0 Then pos = 1 GetCurrentPosition = pos End If Exit Function ErrorHandler: GetCurrentPosition = 0 End Function Private Sub UpdateUI() On Error GoTo SafeExit Dim frm As Form Dim currentPosition As Long Dim isEmpty As Boolean Dim isNew As Boolean Dim isFirst As Boolean Dim isLast As Boolean If Not EnsureHostForm Then If Not mHasLastState _ Or mLastPosition <> 0 _ Or mLastCount <> 0 _ Or mLastIsNew <> False Then Me.lblRecordPosition.Caption = "0 of 0" Me.cmdGoFirst.Enabled = False Me.cmdGoPrevious.Enabled = False Me.cmdGoNext.Enabled = False Me.cmdGoLast.Enabled = False Me.cmdDeleteCurrent.Enabled = False mLastPosition = 0 mLastCount = 0 mLastIsNew = False mHasLastState = True End If Exit Sub End If Set frm = mHostForm currentPosition = GetCurrentPosition() isEmpty = (mRecordCount <= 0) isNew = frm.NewRecord If mHasLastState Then If mLastPosition = currentPosition _ And mLastCount = mRecordCount _ And mLastIsNew = isNew Then Exit Sub End If If isEmpty Then Me.lblRecordPosition.Caption = "0 of 0" Else Me.lblRecordPosition.Caption = currentPosition & " of " & mRecordCount End If isFirst = (currentPosition <= 1 And Not isNew) isLast = (currentPosition >= mRecordCount And Not isNew) Me.cmdGoFirst.Enabled = Not isEmpty And Not isFirst Me.cmdGoPrevious.Enabled = Not isEmpty And Not isFirst Me.cmdGoNext.Enabled = Not isEmpty And Not isLast And Not isNew Me.cmdGoLast.Enabled = Not isEmpty And Not isLast And Not isNew Me.cmdDeleteCurrent.Enabled = Not isEmpty And Not isNew mLastPosition = currentPosition mLastCount = mRecordCount mLastIsNew = isNew mHasLastState = True Exit Sub SafeExit: Debug.Print "UpdateUI Error: "; Err.Number; " - "; Err.Description End Sub Private Sub cmdGoFirst_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub On Error GoTo ErrorHandler With mHostForm.RecordsetClone .MoveFirst mHostForm.Bookmark = .Bookmark End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdGoPrevious_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub If mHostForm.NewRecord Then cmdGoLast_Click Exit Sub End If On Error GoTo ErrorHandler With mHostForm.RecordsetClone .Bookmark = mHostForm.Bookmark If mHostForm.CurrentRecord > 1 Then .MovePrevious mHostForm.Bookmark = .Bookmark End If End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdGoNext_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub If mHostForm.NewRecord Then Exit Sub On Error GoTo ErrorHandler If mHostForm.CurrentRecord >= mRecordCount Then UpdateUI Exit Sub End If With mHostForm.RecordsetClone .Bookmark = mHostForm.Bookmark .MoveNext If Not .EOF Then mHostForm.Bookmark = .Bookmark End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdGoLast_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub On Error GoTo ErrorHandler With mHostForm.RecordsetClone .MoveLast mHostForm.Bookmark = .Bookmark End With UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdCreateNew_Click() On Error GoTo ErrorHandler If Not EnsureHostForm Then Exit Sub mHostForm.SetFocus DoCmd.GoToRecord acDataForm, mHostForm.name, acNewRec RefreshRecordCount True UpdateUI Exit Sub ErrorHandler: HandleNavigatorError Err.Number, Err.Description End Sub Private Sub cmdDeleteCurrent_Click() If Not EnsureHostForm Then Exit Sub If Not HasRecords Then Exit Sub If mHostForm.NewRecord Then Exit Sub If MsgBox("هل تريد حذف السجل الحالي نهائيًا؟", vbYesNo + vbQuestion + vbDefaultButton2, "تأكيد الحذف") <> vbYes Then Exit Sub On Error GoTo ErrorHandler Dim rsClone As DAO.Recordset Dim bm As Variant Dim nextBM As Variant Set rsClone = mHostForm.RecordsetClone bm = mHostForm.Bookmark rsClone.Bookmark = bm rsClone.MoveNext If rsClone.EOF Then rsClone.Bookmark = bm rsClone.MovePrevious If rsClone.BOF Then nextBM = Null Else nextBM = rsClone.Bookmark End If Else nextBM = rsClone.Bookmark End If If mHostForm.Dirty Then mHostForm.Dirty = False End If mHostForm.Recordset.Delete RefreshRecordCount True If IsNull(nextBM) Then mHostForm.SetFocus DoCmd.GoToRecord , , acNewRec Else mHostForm.Bookmark = nextBM End If rsClone.Close Set rsClone = Nothing UpdateUI Exit Sub ErrorHandler: On Error Resume Next If Not rsClone Is Nothing Then rsClone.Close Set rsClone = Nothing End If HandleNavigatorError Err.Number, Err.Description End Sub Private Sub HandleNavigatorError(ByVal errorNumber As Long, ByVal errorDescription As String) Select Case errorNumber Case 0, 3021 Exit Sub Case Else MsgBox "حدث خطأ رقم " & errorNumber & vbCrLf & errorDescription, vbExclamation, "خطأ في أداة التنقل" End Select End Sub Navigator.accdb

رائع

الى هنا تنتهى رحلة من أمتع رحلات حياتى ادين بكل الفضل بعد رب العالمين لكل اساتذتى العظماء جزاكم الله خيـــــــــــــــــــــــــــــــــــــــــــــــــــــرا ها انا اكتب كلماتي الأخيرة هنا...... اليوم أعلن رحيلي عنكم وكلي تألما وتحسرا على فراقكم ولكني وصلت إلى نقطة النهاية..... رسالتي الاخيرة اوجهها إلى كل الاصدقاء الذين كانوا لهم مكانة عالية في قلبي .... إلى كل من أكن لهم كل الاحترام... أشخاص لم أراهم ولم أتعرف عليهم شخصيا ولكن تركوا الاثر الكبير في نفسي...... هناك أشخاص رائعون....رائعون أحببتهم دون أن أراهم كانوا لي أخوة وأخوات..... ولكن هي مراحل بحياتنا..... نرحل ونودع من نحب.... أتمنى أن أكون تركت بصمة طيبة لدي البعض منكم...... إنتهت لحظاتي الجميلة بينكم..... كما ينتهي كل شيئ جميل في هذه الحياة بسرعة......... ولكن لا بد أن نصحو يوما على حقيقة الوداع.... التي نعيشها....... احببتكم وأحببت تواجدي بينكم..... أرجوا أن تذكروني بالخير وإن كنت أسأت لأحدكم فسامحوني وشكرا للجميع......

السلام عليكم ورحمة الله تعالى وبركاته بل كل الشكر لكم استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @ابوخليل لولا فضل الله تعالى ثم حضرتكم وكل اساتذتى العظماء لما وصلت الى هذه الدرجة فلكم منى كل الشكر والتقدير والامتنان والعرفان بالجميل لتحملكم لى ولكل طلاب العلم جزاكم الله خيرا وشكر الله لكم واحسن اليكم كما تحسنون الينا اسال الله تعالى ان يبارك لكم فى اعماركم واعمالكم وذريتكم وجزاكم الله تعالى خيرا على دعواتكم الطيبة اسال الله تعالى ان يرزقكم فضلها وانتظروا ان شاء الله تعالى التحديث الجديد لحل المشكلة الحالية وهى غلق ثغرة امكانية استخدام نفس السيريال لتفعيل اصدار اخر لنفس التطبيق او تفعيل تطبيقات مختلفة لنفس المبرمج عند نفس العميل وهذا ما نبهنى اليه كما اشار استاذى الجليل ومعلمى القدير الاستاذ @ناقل بكل صراحة تشتت افكارى وانا احاول الوصول لشكل سيريال التفعيل فكان هذا كل همى وقت البناء و عملية التكويد ------------ هلا الله اشكركم على متابعتكم وكلماتكم الطيبة

اعتذر عن تأخرى وغياى لظروف عملى ولكن بفضل الله اساتذتى العظماء الحاضرين يسدون عن الغائبين ويكفون ويوفون ما شاء الله عليهم ربى يحفظهم و يرعاهم اذا انتهت مشاكلك فهنيئا لك ومبارك عليك واذا فى اى شئ تعثرت فيه لا تتردد ابدا ارجع واسأل مرارا وتكرارا وان شاء الله تجد كل الدعم هذا المنتدى ماشاء الله بتربع فى سمائه اساتذة عظماء كالنجوم اللامعة فبأيهم تقتدى ان شاء الله سوف تهتدى معلومة ع الماشى ضع اى ملفات صوتية نسخ ولصق فى المجلد : sound files الموجود بجوار القاعدة وسوف تجدها تلقائيا داخل قائمة التشغيل

-- --- السلام عليكم ورحمة الله وبركاته اخوانى واحبابى انا لما طلبت السرايل كانت للتجربة لا اكثر ولا اقل والتجربة اقصد ليه انا مش لاثبت لغيرى شئ او للاستعراض مثلا لان فى البداية واجهت مشاكل بصراحة بسبب كبر الكود وكثرة الافكار واختلاف الاجهزة حتى انه تم التأكد من فاعلية عمل القاعدة مع مستخدمين محدودى الصلاحية ومقيدين من سكيورتى الويندوز وبحمد الله تعالى القواعد عملت على اكمل وجه وبدون اى قصور و انتهت تقريبا بفضل الله كل المشاكل تقريبا وتم التغلب على الصعاب اللى كانت وقمت بوضع النسخة كاملة من قاعدتين الاولى التى تخص العملاء والثانية التى تخص المبرمجين والتى يتم توليد اكواد التفعيل من خلالها فى هذه المشاركة بفضل الله تعالى فى منتدانا لا نبخل على اخواننا ولا نحفى أى شئ

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

تصدق لم تخطر ببالى بس بسيطة ممكن نضيف نقطتين اسم التطبيق الاصدار علشان كمان اذا تعددت الاصدارات يكون لكل اصدار تفعيل مختلف وبعدين ما الاكواد معاكم عيشوا وغيروا وعدلوا وطوروا حسب رغباتكم انا كان كل همى بصراحة شئ واحد فقط شكل السيريال نمبر

اشكرك من قلبى يا صديقى والان اقدم المرفقات النهائية لكم - مرفق توليد كلمات المرور للمبرمجين - مرفق العملاء تفعيل بمدة محددة.zip

ممتاز تم وبدون اى مشاكل زى الاصدار الاول ؟

كود التفعيل 03QI-0500-0000-0EAM منتظر ردك يا استاذ @محمد احمد لطفى

@محمد احمد لطفى , @SAROOK , @Hamtoooo سلام الله عليكم ورحمته وبركاته ده الاصدار الجديد فى انتظار حضراتكم للرد بعد التجربة Clients Demo 2.01.accdb

متشوق جدا جدا لمشاهدة اللقاء

بحمد الله تم حل المشكلة انا الان اتصفح من الجوال ابشروا ان شاء الله قريبا اضع المرفق النهائي

دى ظهرت من اول مره واللا عند محاولة اعادة التفعيل مرة أخرى ؟

هلا والله جرب السيريال 03QI-0500-0000-2I20 وتأكد من هذه الجزئية ربما هناك خلل سوف اعالجه ان شاء الله

اشكرك انت الاروع اتفضل سيريال التفعيل 03P8-0500-0000-0U1Z

وعليكم السلام ورحمة الله وبركاته هلا والله ... حياكم الله اتفضل جرب تفعل بالسريال التالى وأخبرنى النتيجة من فضلك 03PK-0500-0000-0U2B

اهلا بيك فى المنتدى وتحت امرك بأى وقت

مش عارف الحل ده ممكن واللا لا انا اساسا مش عارف اذا كنت اساسا فهمت المطلوب Private Sub mjal_AfterUpdate() Dim strSQL As String ' تحديد مصدر السرد بناء على الاختيار Select Case Me.mjal.Column(1) Case "فردي1", "فردي2" ' إخفاء "زوجي" strSQL = "SELECT ac_id, ac_Name FROM tbl_Mjal WHERE ac_Name NOT IN ('زوجي')" Case "زوجي" ' إخفاء "فردي1" و"فردي2" strSQL = "SELECT ac_id, ac_Name FROM tbl_Mjal WHERE ac_Name NOT IN ('فردي1', 'فردي2')" Case Else ' إظهار جميع الخيارات strSQL = "SELECT ac_id, ac_Name FROM tbl_Mjal" End Select ' تحديث مصدر مربع السرد Me.mjal.RowSource = strSQL Me.mjal.Requery End Sub Private Sub Form_Load() ' تعيين مصدر السرد الافتراضي عند تحميل النموذج Me.mjal.RowSource = "SELECT ac_id, ac_Name FROM tbl_Mjal" Me.mjal.Requery End Sub المرفق Database2.accdb

المشكلة ان قاعدة البيانات حصل فيها تلف Corruption انا عملت قاعدة جديدة وقمت بعمل استيراد لكل شئ من القاعدة القديمة واشتغلت تمام Fleet.accdb

رسالة الخطأ اللى في الصورة Invalid procedure call or argument نداء إجراء غير صالح او وسيط غير صحيح ده معناه ان هناك دالة أو إجراء تم تمريره له قيمة غير مناسبة واتصور أنه في زر تحديث الكيلومتر (btnUpdateMileage_Click) إذا كان Me.CurrentMileage فارغا (Null) أو غير رقمي أو تم إدخاله من عنصر تحكم غير موجود أو غير معرف فإن المقارنة تؤدي إلى الخطأ الذي ظهر اقرب الاحتمالات التى اتصورها هذا السطر If newMileage > Me.CurrentMileage Then لو ترسل القاعدة يكون افضل

ان انا فهمت صح جرب التعديل على مرفق الاستاذ @منتصر الانسي (2)قاعدة بيانات.accdb

وهذا ما افضله تمام لان البيانات من حق العميل وتقريبا هذه فكرة : ولكن هى مازالت قيد التطوير كنت بدأت بها من فترة ولا اعرف لماذا توقفت ولكن يمكن تجربة المرفق منع اعادة التفعيل بعد انتهاء المدة منع نسخ القاعدة لجهاز آخر يتم اكتشاف التلاعب بالتاريخ والاكواد مكتوبة برخامة حبتين علشان ازهق المبرمج اللى عاوز يكسر الحماية وطبعا دى احدى الطبقات للحماية سوف يتم تغليفها بطبقات متعددة لزيادة مستوى الحماية