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

[hussein arby]

صممت برنامج علي اكسس 2007 واريد عمل عمل كود يقفل البرنامج بعد فتره معينه مثلا 30 يوم لبكون البرنامج للتجربه فقط وشكرا

[ابوخليل]

Private Sub Form_Load()
Dim xdate As Date
Dim Ndate As String
Dim mssg As String
xdate = #12/23/2014#
If xdate <= Date Then
MsgBox "انتهت الفترة التجريبية فضلا اتصل على 123456789"
Quit
Else
Ndate = CStr(xdate - Date)
mssg = "المدة المتبقية" & " " & Ndate & " " & "يوم"
MsgBox mssg
DoCmd.Close
End If
End Sub

[وائل احمد المصري]

 

Private Sub Form_Load()
Dim xdate As Date
Dim Ndate As String
Dim mssg As String
xdate = #12/23/2014#
If xdate <= Date Then
MsgBox "انتهت الفترة التجريبية فضلا اتصل على 123456789"
Quit
Else
Ndate = CStr(xdate - Date)
mssg = "المدة المتبقية" & " " & Ndate & " " & "يوم"
MsgBox mssg
DoCmd.Close
End If
End Sub

 

أخي بارك الله فيك

كود رائع ولكن تبقى مشكلة ان المستخدم اذا قام بتغيير وقت الجهاز سيعمل البرنامج

[ابوخليل]

وجدت في مكتبتي هذا المثال لابن مسقط

وهو يعالج هذه الجزئية

إيقاف بالمدة.rar

[عاشق الاسلام]

 

Private Sub Form_Load()
Dim xdate As Date
Dim Ndate As String
Dim mssg As String
xdate = #12/23/2014#
If xdate <= Date Then
MsgBox "انتهت الفترة التجريبية فضلا اتصل على 123456789"
Quit
Else
Ndate = CStr(xdate - Date)
mssg = "المدة المتبقية" & " " & Ndate & " " & "يوم"
MsgBox mssg
DoCmd.Close
End If
End Sub

 

السلام عليكم استاذ ابو خليل أين يوضع الكود

[.Azhar]

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

وهذا كود اخر لا علاقه له بالتاريخ , وانما يعتمد على عدد مرات فتح البرنامج وبعد انتهاء العدد المسموح به تخرج رساله تنبهك بشراء البرنامج . 

بالضبط كالبرامج التي تباع بالانترنيت تستطيع فتحها لمدة مرتين فقط . 

لكن هنا في الكود جعلت عدد مرات فتح البرنامج 100 مرة . 

Private Sub Form_Current()
retvalue = GetSetting("A", "0", "Runcount")
GD$ = Val(retvalue) + 1
SaveSetting "A", "0", "RunCount", GD$
If GD$ > 100 Then
MsgBox ("انتهت مدة تشغيل البرنامج عليك بشراء البرنامج او الاتصال بالمطور"), , ("AZHAR ALIraqy")
DoCmd.Quit
End If

End Sub

[ابوخليل]

 

السلام عليكم استاذ ابو خليل أين يوضع الكود

 

 

 كما هو ظاهر يوضع  في حدث  عند تحميل النموذج  ( نموذج بداية التشغيل )

[hussein arby]

شكرا اخواني علي المجهود العظيم وجزاكم الله خيرا

[chouchou]

السلام عليكم 

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

[gida]

بعد اذن حضراتكم ايه هو التاريخ لفتح هذة القاعدة عشان مش بتفتح

[Hosam Shehata]

التاريخ بالجدول اخى 

[أحمد عبدالله محمد البعداني]

ممكن سؤال كيفية الغاء فترة التجربة في اكسس لو تكرمتم

[eng aoff]

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

[Gamor]

اخي بعد اذنك اين يوضع هذا الكود

 

[محمد أبوعبدالله]

اخي الكريم يوضع الكود كاملاً في النموذج = حدث في الحالي

 

الكود فقط

retvalue = GetSetting("A", "0", "Runcount")
GD$ = Val(retvalue) + 1
SaveSetting "A", "0", "RunCount", GD$
If GD$ > 100 Then
MsgBox ("انتهت مدة تشغيل البرنامج عليك بشراء البرنامج او الاتصال بالمطور"), , ("AZHAR ALIraqy")
DoCmd.Quit
End If

الحدث فقط

Private Sub Form_Current()
' هنا يتم كتابة الاكود

End Sub

تحياتي

[m.r]

اختي ازهار ضهر عندي خطأ

[محمد أبوعبدالله]

عطل السطر الثاني هكذا

Option Compare Database
'Option Explicit

Private Sub Form_Current()
retvalue = GetSetting("A", "0", "Runcount")
GD$ = Val(retvalue) + 1
SaveSetting "A", "0", "RunCount", GD$
If GD$ > 100 Then
MsgBox ("انتهت مدة تشغيل البرنامج عليك بشراء البرنامج او الاتصال بالمطور"), , ("AZHAR ALIraqy")
DoCmd.Quit
End If

End Sub

تحياتي