اضافة قيمة الى ريجستري

[ايمن14]

السلام عليكم

اخواني واساتدتي 

المرجوا كود اضافة قيمة حقل من جدول الى ريجيستري

واكون شاكرا

[kanory]

راجع هذا الموضوع تجد فيه طلبك ....

في ٤‏/٦‏/٢٠١٧ at 00:47, صالح حمادي said:

شرح البرنامج:

1- يتعامل البرنامج مع الرجستري في حماية النسخة ( الريجستري عباره عن قاعدة بيانات في نظام التشغيل Windows .و يحتوي على معلومات أجهزة النظام و البرامج المثبتة والإعدادات، و بيانات حسابات المستخدمين على الكمبيوتر. و أي عملية تقوم بها على الجهاز تخزن بالريجستري . )

2- عند أول تشغيل للبرنامج يقوم بحفظ تاريخ أول يوم للاستخدام و عدد أيام النسخة التجريبية و خوارزمية التفعيل كلها في الرجستري و يحذف الجدول الذي يحمل جميع البيانات بعد نقلها و حفظها بالرجستري.

3- للإطلاع على الجدول tbl الذي يشتمل المعلومات المهمة يجب عليك فتح البرنامج في وضع التصميم دون تشغيله لأنه عند أي تشغيل للبرنامج سوف يحذف الجدول و في حال لم تجد الجدول حمل نسخة أخرى من البرنامج.

4- اسم الحقل الذي يحدد مدة الفترة التجريبية هو nemberday

5- كل مرة تقوم بتشغيل البرنامج يقوم بحفظ التاريخ و الوقت الحاليين في الرجستري لمنع التلاعب بالتاريخ.

6- لحفظ قيمة بالرجستري نستخدم الكود التالي:

SaveSetting AppName , Section, Key ,Setting 
appName  اسم المجلد الرئيسي 
Section القسم  
KEY المفتاح
Setting القيمة المراد تخزينها

7- لاستعادة القيمة من الرجستري نستخدم الكود التالي:

dim X
X = GetSetting(AppName , Section, Key)
X هو الذي سوف يأخذ القيمة التي سوف نستدعيها

8- لحذف القيمة من الرجستري نستعمل الكود التالي:

DeleteSetting AppName , Section, Key

9- و هذه هي الوحدة النمطية التي إستعملتها في البرنامج:

Function salah(frm1 As String, frm2 As String, frm3 As String)
'On Error Resume Next
Dim firstdate As Date
Dim lastdate As Date
Dim lasttime As Date
Dim expdate As Date
Dim nameschool As String
Dim numschool As Double
Dim khawarezmia As String
Dim nember_days As Integer


'--------------------------------------------------------------------
firstdate = GetSetting("aa", "bb", "firstdate", Nz(firstdate))
If firstdate = Empty Then
SaveSetting "aa", "bb", "firstdate", Date
End If
firstdate = GetSetting("aa", "bb", "firstdate", Nz(firstdate))
'---------------------------------------------------------------------
lastdate = GetSetting("ss", "tt", "lastdate", Nz(lastdate))
If lastdate = Empty Then
SaveSetting "cc", "dd", "lastdate", Date
End If
lastdate = GetSetting("ss", "tt", "lastdate", Nz(lastdate))
'---------------------------------------------------------------------
lasttime = GetSetting("zz", "hh", "lasttime", Nz(lasttime))
If lasttime = Empty Then
SaveSetting "ee", "ff", "lasttime", Now
End If
lasttime = GetSetting("zz", "hh", "lasttime", Nz(lasttime))
'---------------------------------------------------------------------
nember_days = GetSetting("mm", "nn", "nember_days", Nz(nember_days))
If nember_days = Empty Then
nember_days = 1
End If
expdate = DateAdd("d", nember_days, firstdate)
'---------------------------------------------------------------------
khawarezmia = GetSetting("gg", "pp", "khawarezmia", Nz(khawarezmia))
If khawarezmia = Empty Then

   numschool = DLookup("numscho", "tbl")
   SaveSetting "ii", "jj", "numschool", numschool
   
   khawarezmia = DLookup("khawr", "tbl")
   khawarezmia = Replace(khawarezmia, "numschool", numschool)
   SaveSetting "gg", "pp", "khawarezmia", khawarezmia
 
   nameschool = DLookup("namescho", "tbl")
   SaveSetting "kk", "ll", "nameschool", nameschool
   
   nember_days = DLookup("nemberday", "tbl")
   SaveSetting "mm", "nn", "nember_days", nember_days
End If

For Each ttable In CurrentData.AllTables
   If ttable.Name = "tbl" Then
       DoCmd.DeleteObject acTable, ttable.Name
   End If
Next

If Date < lastdate Then
   MsgBox "تاريخ الجهاز خاطئ"
   DoCmd.Quit
  
Else
    If Date = lastdate And lasttime > Now Then
    MsgBox "ساعة الجهاز خاطئة"
    DoCmd.Quit
    End If

   If Date >= expdate Then
   MsgBox "إنتهاء مدة التفعيل عليك الإتصال بالمبرمج "
   SaveSetting "mm", "nn", "nember_days", 1
   DoCmd.OpenForm frm3
   DoCmd.Close acForm, frm1
   Else
   SaveSetting "zz", "hh", "lasttime", Now
   SaveSetting "ss", "tt", "lastdate", Date
   nt = DateDiff("d", Date, expdate)
   MsgBox "بقي لك " & nt & " يوم على إنتهاء التفعيل"
   DoCmd.OpenForm frm2
   DoCmd.Close acForm, frm1
   End If
End If

End Function

10- و هذا الكود الخاص بإعادة التفعيل:

numschool = GetSetting("ii", "jj", "numschool", Nz(numschool))
'---------------------------------------------------------------------
khawarezmia = GetSetting("gg", "pp", "khawarezmia", Nz(khawarezmia))
'---------------------------------------------------------------------
nameschool = GetSetting("kk", "ll", "nameschool", Nz(nameschool))
'---------------------------------------------------------------------
nember_days = GetSetting("mm", "nn", "nember_days", Nz(nember_days))
'---------------------------------------------------------------------

If Me.numero_act = Eval(khawarezmia) Then
SaveSetting "mm", "nn", "nember_days", 140
nember_days = GetSetting("mm", "nn", "nember_days", Nz(nember_days))
DeleteSetting "aa", "bb", "firstdate"
DeleteSetting "ss", "tt", "lastdate"
DeleteSetting "zz", "hh", "lasttime"
MsgBox "لقد تم تفعيل برنامجك لمدة" & nember_days & " يوما"
salah Me.Name, "drm", "نموذج1"
Else
MsgBox "رقم التفعيل خاطئ"
End If

و هذا هو البرنامج مفتوح المصدر بصيغة 2010 و 2003

 

فترة تجريبية.rar

فترة تجريبية2003.rar