عمل نسخة محددة العرض من البرنامج - تجريبية Demo

[أبو وليد]

اريد ان اجعل البرنامج يعمل لفترة زمنية محددة ويتعطل بعد هذه المدة ولا ينفع تغيير تاريخ الجهاز

سبق ان شاهدت مثال على ذلك ولكنني لم افهمه

[امير عاطف]

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

وها هو مثال لذلك:

If DCount("number", "TableName") > 10 Then

MsgBox "انتهت مدة استخدام النسخة التجريبية", vbOKOnly + vbInformation, "Officena"

DoCmd.Quit

[ashraf]

مثال ديمو على عدد الحقول من عمل الأخ العزيز الحارث .

مضغوط على الون رارا

DEMO.rar

[أبو وليد]

هذا كود ليجعل البرنامج يعمل لفترة زمنية محددة ارجو عمل مثل عليه

Private Sub Form_Open(Cancel As Integer)

On Error GoTo MyErr:


Dim MyFirst As Date

Dim MyInDate

Dim MyTableName As String

MyInDate = DFirst("[Date1]", "[T1]")

If Not IsNull(MyInDate) Then

MyFirst = MyInDate

Else

DoCmd.SetWarnings False

DoCmd.RunSQL ("INSERT INTO T1 ( Date1 ) SELECT Date();")

DoCmd.SetWarnings True

MyFirst = Date

End If


If MyFirst <= Date - 3 Then '[color=green] غير الرقم من 3 الى اي عدد تريد[/color]

MsgBox"مضى على التشغيل 3 ايام وسيتم ايقافه"

Call TableDelete

Else

If MyFirst > Date Then

MsgBox"تم التلاعب بتاريخ الجهاز وسيتم ايقاف تشغيله"

Call TableDelete

End If

End If


Exit Sub




MyErr:

If Err.Number = 3078 Then

MsgBox"تم تعطيل البرنامج"

'  Quit

'قمت بتعطيل الامر خروج لتروا الطريقة

Else

MsgBox Err.Number & vbCrLf & Err.Description

End If


End Sub



Function TableDelete()

On Error Resume Next

Dim MyDb As Database

Dim MyTable As TableDef

Dim MyTableCount As Integer


Set MyDb = Application.CurrentDb

MyTableCount = MyDb.TableDefs.Count

For i = MyTableCount - 1 To o Step -1

Set MyTable = MyDb.TableDefs(i)

MyTableName = MyTable.Name

If Left$(MyTableName, 4) <> "Msys" Then MyDb.TableDefs.Delete (MyTableName)

Next

MyDb.Close

End Function

تم تعديل سبتمبر 8, 2003 بواسطه أبو وليد

[ashraf]

جربت الكود على السريع بالخطوات التالية :

1- انشئ نموذج وضع الوحدة النمطية كلها قص ولصق فى النموذج وذلك عن طريق ( عرض ثم تعليمات برمجية ) .

2- احفظ النموذج .

3- انشئ جدول وسمه باسم t1 وضع بداخله حقل تاريخ اسمه date1 ولا تضع فيه أي تاريخ

4- قم بتشغيل النموذج ستجد أنه يفتح عادي بدون مشاكل .

5- اذهب وافتح الجدول ستجد تاريخ اليوم بداخله .

6- غير التاريخ إلى قبل تاريخ اليوم بثلاث أو اربع أيام .

7- قم بتشغيل النموذج مرة أخرى .

ستظهر لك رسائل البرنامج . وستلاحظ أن الجدول قد تم حذفه .

هذا ما جربته سريعا على هذا الكود .

أشرف خليل

[امير عاطف]

وهذا الكود ايضاً يقوم بنفس المهمة ... حيث ما عليك الاّ وضعه عند حدث الفتح On Open لنموذج بدء التشغيل Start UP

واذا تعدى استخدام النسخة 30يوماً يقوم باظهار رسالة تخبر المستخدم بانتهاء استخدام النسخة ويتم اغلاق قاعدة البيانات واذا تم التلاعب بتاريخ الجهاز تخبره ايضاً بالتلاعب ويتم الاغلاق الفوري

Private Sub Form_Open(Cancel As Integer)

   On Error Resume Next

   Dim db As DAO.Database

   Dim tbl As DAO.TableDef

   Dim fld As DAO.Field

   Dim rst As DAO.Recordset

   Dim beforelast As Date

   Dim beforelast2 As Date

   Set db = CurrentDb

   Set tbl = db.CreateTableDef("tbldate")

   Set fld = tbl.CreateField("dtmstart", dbDate)

   tbl.Fields.Append fld

   db.TableDefs.Append tbl

   Set rst = db.OpenRecordset("tbldate")

   rst.MoveFirst

   If DCount("dtmstart", "tbldate") > 1 Then

      Do Until rst.EOF

           beforelast = rst!dtmstart

           rst.MoveNext

           beforelast2 = rst!dtmstart

           If beforelast2 < beforelast Then

                MsgBox "تم التلاعب بتاريخ الجهاز", vbOKOnly, "Officena"

                rst.Close

                db.Close

                DoCmd.Quit

                Exit Do

           End If

      Loop

   End If

   rst.MoveLast

   beforelast = rst!dtmstart

   rst.AddNew

   rst!dtmstart = date

   rst.Update

   rst.Close

   db.Close

   If date > DLookup("dtmstart", "tbldate") + 30 Then 'هنا عدد ايام النسخة 30يوم يمكنك بالطبع تغييرها لعدد الأيام التي تريدها

       MsgBox "انتهت مدة استخدام النسخة التجريبية", vbOKOnly, "Officena"

       DoCmd.Quit

       ElseIf date < DLookup("dtmstart", "tbldate") Or _

       DLast("dtmstart", "tbldate") < beforelast Then

       MsgBox "تم التلاعب بتاريخ الجهاز", vbOKOnly, "Officena"

       DoCmd.Quit

   End If

End Sub

[أبو وليد]

وفقكم الله

اخي العزيز

ماذا لو تم فتح الجدول ("tbldate")

واعادة كتابة تاريخ قديم

=========

هل استطيع كم بقي من المدة للعمل

يعني لو اشتغل البرنامج خمس ايام بقي له 25 يوم

تم تعديل سبتمبر 11, 2003 بواسطه أبو وليد

[ahmedspcc]

السلام عليكم ورحمة الله وبركاته وبعد

ايه الاخوة الكرم

هل من الممكن عمل تاريخ محدد يتوقف عنده البرنامج عن العمل

وشكراً

اخوكم

فرحان منطنط المسروري :lol:

[سحـــاب]

تفضل هذا الكود الصقه في حدث عند التحميل للبرنامج

هذا كود من عمل اخي محمد طاهر أو اخي ابن مسقط لست متأكدا وانما هو واحد منهم اللي صلحه وكثر الله خيرهم

If Date > #8/15/03# Then

MsgBox "عفوا ،،،،، لقد إنتهت مدة عرض البرنامج ،،،، فضلا إتصل بالموزع !!!!", vbOKOnly, "تنيبه"

DoCmd.quit

End If

[ابن مسقط]

السلام عليكم ورحمة الله وبركاته

المرفق به مثال لطريقة أخرى.

Expire.rar

[ahmedspcc]

شكراً سحاب شركة ابن مسقط

السلام عليكم ورحمة الله

اخواني كلى الطريقتين ممتازة لكن هل من الممكن ان اظهر رسالة تنبيه تبين ان البرنامج سوف ينتهي الصلاحيبة به بعد 15 يوم واليوم الثاني تظهر الرسالة بعد 14 يوم وهكذا وبارك الله فيكم جميعاً\

أخوكم

فرحان منطنط المسروري

[ابن مسقط]

أخي الكريم/ فرحان منطنط المسروري

أرجوا المعذرة ، فلم أجد حلاً حتى الآن لما تطلبه

قد يفيدك أحد أساتذتنا في المنتدى إلى الطريقة.

[ahmedspcc]

اخي الكريم ابن مسقط المحترم

السلام عليكم ورحمة الله

اشكر على ماتقدمه والله اسائل ان يثيبك

اخوك

فرحان منطنط المسروري

[ahmedspcc]

ياجماعة السلام عليكم ورحمة الله

مازلنا ننتظر كرمكم علينا ءالرجاء

اخواني كلى الطريقتين ممتازة لكن هل من الممكن ان اظهر رسالة تنبيه تبين ان البرنامج سوف ينتهي الصلاحيبة به بعد 15 يوم واليوم الثاني تظهر الرسالة سوف ينتهي الصلاحيبة به بعد14 يوم وهكذا وبارك الله فيكم جميعاً\

اخوكم

فرحان منطنط المسروري

[egyptian_eg]

If Date > #8/15/03# Then

msgbox "Time Over"

else

msgbox "Time remaining" & Str(#8/15/03# - date)

DoCmd.quit

End If

[ahmedspcc]

السيد / egybtian-eg او عمر مصر المحترم

السلام عليكم ورحمة الله وبركاته وبعد

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

اخوك

فرحان منطنط المسروري

[محمد طاهر عرفه]

 If Date > #11/18/2003# Then

   MsgBox "Time Over"

 Else

    x = MsgBox("Time remaining" & Str(#11/18/2003# - Date) & " days , do you want to Continue ??", vbYesNo, "www.officena.net")

    If x = vbNo Then

    DoCmd.Quit

    End If

End If

[ahmedspcc]

سعادة المهندس / محمد طاهر المحترم

السلام عليكم ورحمة الله وبركاته بعد

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

اخوك

فرحان منطنط المسروري

[ابن مسقط]

بعد إذن الاستاذ/ محمد طاهر

جرب الكود مره ثانيه بعد التعديل عليه في الأتي :

[ALIGN=left]

If Date > #11/18/2003# Then

  MsgBox "Time Over"

  DoCmd.Quit

Else

   x = MsgBox("Time remaining" & Str(#11/18/2003# - Date) & " days , do you want to Continue ??", vbYesNo, "www.officena.net")

   If x = vbNo Then

   DoCmd.Quit

   End If


 End If

تم تعديل نوفمبر 15, 2003 بواسطه ابن مسقط

[ahmedspcc]

شكراً اخي المهندس / محمد طاهر المحترم

شكراً اخي الاستاذ / ابن مسقط المحترم

والله يحفظكم ويثبكم عنا خير الجزاء

[ahmedspcc]

السلام عليكم ورحمة الله وبركاته وبعد

ايه الاخوة الكرم لا اعرف كيف اشكركم على سعة صدوركم لي ، ولكن ماذا لو اني ارغب في ان اضع الكود في البرنامج الان واعياره بتاريخ 01/01/2004 ولكن لا ارغب ان يعمل الى قبل خمسة عشر يوم من هذا التاريخ الذي وضعته له ، بمعنا ان لا يكون للكود اي اثر في الواقت الحاظر الى ان لا يبقى سوى خمسة عشر يوم يبداء بالعمل . وشكراً على تحملكم لنا

اخوكم

فرحان منطنط المسروري

[alali100]

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

بالتأكيد لا

اذن فماهي الوسيله الأفضل لايقاف البرنامج عن العمل بخلاف خاصية الوقت والتاريخ .

[محمد طاهر عرفه]

شكرا للأخ ابن مسقط علي الاضافة :(

الأخ أحمد :

If Date > #11/18/2003# Then

 MsgBox "Time Over"

 DoCmd.Quit

Else

  Dim MydateDiff As Integer

  MydateDiff = (#11/18/2003# - Date)

    If MydateDiff <= 15 Then

      x = MsgBox("Time remaining" & Str(MydateDiff) & " days , do   you want to Continue ??", vbYesNo, "www.officena.net")

      If x = vbNo Then

      DoCmd.Quit

      End If

    End If

End If

الأخ علالي قم بتسجيل تاريخ اليوم فى حقل فى جدول و قبل التسجيل ثانية ( عند فتح البرنامج مثلا ) قم بمقارنة التاريخ المسجل مع تاريخ اليوم باستخدام Dlookup فاذا اكتشفت أن التاريهخ اليوم أقل من المسجل فارفض الدخول و عموما فالحل الافضل لل demo هو عمل شرط علي عدد السجلات فى جدول مهم و ليس الزمن فتقوم عند الفتح بعد السجلات و اذا زادت عن حد معين ترفض الدخول أو تجري الاختبار عند الاضافة ، و ترفض التسجيل اذا زاد العدد عن المسموح

if Dcount("[FieldName]", "TableName") > 50 then Docmd.quit

أو تظهر رسالة إن أردت :

If DCount("number", "TableName") > 10 Then

MsgBox "انتهت مدة استخدام النسخة التجريبية", vbOKOnly + vbInformation, "Officena"

DoCmd.Quit

end if

تم تعديل ديسمبر 30, 2003 بواسطه امير عاطف