ازاي اخلي البرنامج بتاعي يشتغل مدة معينة وبعد فترة ينتهي لمدة شهر مثلا او اسبوع وبعد كدة ينتهي او تطلع رسالة تبين للمستخدم ان البرنامج هينتهي
كيف اعمل ذلك
بســم الله الـرحمــن الرحيــم
لا خير في كاتم العلم ...زكاه العلم ...التعليم صدقة جارية
عمل برنامج نسخة تجريبية
مغلق
انسخ هذا الكود الى حدث تحميل وتنشيط النموذج الرئيسي في التطبيق .
" مثلا في حدث :Form_Load و حدث Form_Activate "
و هذا الكود يجعل البرنامج تجريبي لمدة 31 يوم ( و بالطبع يمكنك التعديل في الكود ليناسبك )
Dim startdate As String
Dim differenceofdate
Dim TRACEDATE As String
Dim newdate
Dim chk
If GetSetting(App.Title, "Startup", "counter", "") = "" Then
SaveSetting App.Title, "Startup", "counter", 1
SaveSetting App.Title, "Startup", "Started", Format(Date, "mm dd yyyy")
SaveSetting App.Title, "Startup", "Last Used", Format(Date, "mm dd yyyy")
lblcnt.Caption = "1"
ElseIf GetSetting(App.Title, "Startup", "counter", "") = "31" Then
MsgBox "شكراً لستخدامك هذا البرنامج " & Chr(10) + Chr(1) & "الرجاء إيقاف عمل هذا البرنامج او سيتم فقدان كل المعلومات التي قمت بإدخالها ", vbCritical, "شكراً لك "
End
Else
TRACEDATE = GetSetting(App.Title, "Startup", "Last Used", "")
chk = DateDiff("d", CDate(TRACEDATE), Now)
If chk < 0 Then 'CHECK IF THE DATE WAS CHANGE which is lesser than the PREVIOUS DATE WHERE THE SYSTEM USED.
MsgBox "لم يتم العثور على تاريخ النظام لديك !! " & Chr(10) + Chr(13) & " الرجاء تغييرة الأن وإلا لن يكون بإمكانك إستخدام هذا البرنامج لاحقاً", vbCritical, "تاريخ مفقود"
End
Else
startdate = GetSetting(App.Title, "Startup", "Started", "")
differenceofdate = DateDiff("d", startdate, Now)
If differenceofdate <> 0 Then
lblcnt.Caption = differenceofdate + 1
SaveSetting App.Title, "Startup", "Last Used", Format(Now, "MM DD YYYY")
SaveSetting App.Title, "Startup", "counter", differenceofdate + 1
End If
If differenceofdate = 0 Then
lblcnt.Caption = GetSetting(App.Title, "Startup", "Counter", "")
End If
End If
End If
End Subتفضل اخي الكريم حمل من المرفقات
جميل جدا و الى الامام
هذا الموضوع مغلق.