اذهب الي المحتوي
أوفيسنا

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


hussein arby
إذهب إلى أفضل إجابة Solved by محمد أبوعبدالله,

الردود الموصى بها


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
  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

 


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

 

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

رابط هذا التعليق
شارك

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

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

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

لكن هنا في الكود جعلت عدد مرات فتح البرنامج 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

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

  • 3 weeks later...
  • 1 year later...
  • 6 months later...
  • 2 years later...
  • 8 months later...

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

 

الكود فقط



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

تحياتي

رابط هذا التعليق
شارك

  • أفضل إجابة

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

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

تحياتي

  • Like 2
رابط هذا التعليق
شارك

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

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information