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

استعرض الموضوع السابق استعرض الموضوع التالي اذهب الى الأسفل

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

مُساهمة من طرف المبرمج الطموح في الأربعاء يوليو 17, 2013 9:42 am

بسم الله الرحمن

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

الرمز:

    Private str As String
    Private str1 As String
    Private str2 As String
    Private initialDate As Date
    Private expDate As Date
    Private usedDate As Date
    Private Expire As Boolean
    
   Sub Main()
        Call Expire_Project
    End Sub
    
   
   Public Sub Expire_Project()
    str = GetSetting("Project Name", "Expiry", "Initial Date")
    'First Get the Value from the Registry
    
   If Len(Trim(str)) < 1 Then
    'If the Registry Value is not set then Set the Value
        SaveSetting "Project Name", "Expiry", "Initial Date", Date
        expDate = DateAdd("d", 15, Date)
        'Add 15 days to the Current Date
        SaveSetting "Project Name", "Expiry", "Expiry Date", expDate
        'Here I have Given 15 days for expiration of the Software You can Give 'n' no of days as you like
    Else
        str1 = GetSetting("Project Name", "Expiry", "Used Date")
        'If this Registry Value is not Set then
        If Len(Trim(str1)) < 1 Then
            str = GetSetting("Project Name", "Expiry", "Initial Date")
            'Get the Previously set Initial Value from the Registry
            initialDate = CDate(str)
            str2 = GetSetting("Project Name", "Expiry", "Expiry Date")
            'Get the Expiry Value from the Registry
            expDate = CDate(str2)
                If Date > expDate Or Date < initialDate Then
                'Compare Registry Values with the Date, if they are bound with in the Initial Value of the Software and Expiry Value of the SOftware then only the Program will run
                    SaveSetting "Project Name", "Expiry", "Used Date", "True" 'Now set the Used Date value to True
                    MsgBox "Software Has Been Expired; You cannot run the Software by Setting the Date Backwards", vbExclamation, "Software Expired"
                    Expire = True
                    Exit Sub
                End If
            Else
                MsgBox "Software Has Been Expired; You cannot run the Software by Setting the Date Backwards", vbExclamation, "Software Expired"
                Expire = True
                Exit Sub
            End If
    End If
    End Sub

المبرمج الطموح
الاشراف
الاشراف

تاريخ التسجيل : 18/02/2011
المساهمات : 117
النقاط : 213
التقيم : 6
الدولة : مصر
الجنس : ذكر

الرجوع الى أعلى الصفحة اذهب الى الأسفل

استعرض الموضوع السابق استعرض الموضوع التالي الرجوع الى أعلى الصفحة


 
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى