When i am first time run application all code working properly not any error when i am close the application. Then re-open application
Error will be display ("Requested registry access is not allowed") how can i open or allowed registry. Code is under bellow
What I have tried:
Imports Microsoft.Win32
Public Class RegistryTrial
Private Last, First, RemainsDays, RemainsDays1, strOldDay, strOldMonth, strOldYear As String
Private mintSystem_UsedTrialDays As Integer
Public StartDate As String
Public LastDate As String
Public FinalDate, FinalDateTime As String
Private WebPage_Page As Web.AspNetHostingPermission
Public Function Regedit(ByVal TrialPeriod As Integer) As String
Dim regKey As RegistryKey
Try
Dim strRet As String = "0"
regKey = Registry.LocalMachine.OpenSubKey("SOFTWARE", True)
regKey = Registry.LocalMachine.OpenSubKey("Software\AppSecurity", True)
If regKey Is Nothing Then
regKey = Registry.LocalMachine.OpenSubKey("SOFTWARE", True)
regKey.CreateSubKey("AppSecurity")
regKey.Close()
If WriteValue(TrialPeriod) = False Then
Return "setting fail."
End If
Else
strRet = GetValueFromReg(TrialPeriod)
Return strRet
End If
Catch ex As Exception
Return ""
End Try
End Function
Public Function GetValueFromReg(ByVal mintTrialPeriod As Integer) As String
Dim strReturn As String = ""
Dim regKey As RegistryKey
Dim ver, Final As String
regKey = Registry.LocalMachine.OpenSubKey("Software\AppSecurity", True)
ver = regKey.GetValue("System_In")
If ver = "" Then
Return "You have change some module,you are un-authorised to use the application."
Else
Final = funcDecrpt_Date(ver)
If Final.Length() = "21" Then
Last = Final.Substring(11)
strOldDay = Final.Substring(0, 2)
strOldMonth = Final.Substring(3, 2)
strOldYear = Final.Substring(6, 4)
First = Final.Substring(0, 10)
RemainsDays = DisplayApplicationStatus(DiffDate(strOldDay, strOldMonth, strOldYear), mintTrialPeriod)
mintSystem_UsedTrialDays = DiffDate(strOldDay, strOldMonth, strOldYear)
Dim todaydate As String
todaydate = Format(Today, "dd/MM/yyyy")
If RemainsDays1 = 0 Then
Return "Sorry,Your trial period is over!!Please purchase this software."
Else
Dim LastMonth As String
Dim CurrentMonth As String
LastMonth = Last.Substring(3, 2)
CurrentMonth = todaydate.Substring(3, 2)
If LastMonth > CurrentMonth Then
If Last = todaydate Or First > todaydate Then
Return "Sorry,Your trial period is over!!Please purchase this software."
Else
strReturn = GetLastAccessDateTime()
If strReturn <> "LogIn" Then
Return strReturn
Else
If RemainsDays1 = Nothing Then
Return "123Today is your last day in your free trial period."
Else
Return "123You have " & RemainsDays1 & " days remaining in your free trial period."
End If
End If
End If
Else
If Last = todaydate Or Last < todaydate Or First > todaydate Then
Return "Sorry,Your trial period is over!!Please purchase this software."
Else
strReturn = GetLastAccessDateTime()
If strReturn <> "LogIn" Then
Return strReturn
Else
If RemainsDays1 = Nothing Then
Return "123Today is your last day in your free trial period."
Else
Return "123You have " & RemainsDays1 & " days remaining in your free trial period."
End If
End If
End If
End If
End If
Else
Return "You have change some module,you are un-authorised to use the application."
End If
End If
End Function
Public Function funcEncrpt_Date(ByVal mDate As String) As String
Dim intI As Integer = 0
Dim mstrDate As String = ""
Try
For intI = 1 To Len(mDate)
If Mid(Trim(mDate), intI, 1) = "1" Then
mstrDate = mstrDate & ChrW(Asc(Mid(Trim(mDate), intI, 1)) - 5)
Else
mstrDate = mstrDate & ChrW(Asc(Mid(Trim(mDate), intI, 1)) - 10)
End If
Next
If InStr(mstrDate, "'") <> 0 Then
mstrDate = mstrDate & "'"
End If
Catch ex As Exception
End Try
Return mstrDate
End Function
Public Function funcDecrpt_Date(ByVal mDate As String) As String
Dim intI As Integer = 0
Dim mstrDate As String = ""
Try
For intI = 1 To Len(mDate)
If Mid(Trim(mDate), intI, 1) = "," Then
mstrDate = mstrDate & ChrW(Asc(Mid(Trim(mDate), intI, 1)) + 5)
Else
mstrDate = mstrDate & ChrW(Asc(Mid(Trim(mDate), intI, 1)) + 10)
End If
Next
Catch ex As Exception
End Try
Return mstrDate
End Function
Public Function WriteValue(ByVal TrialPeriod As Integer) As Boolean
Dim regKey As RegistryKey
Dim SaveFirstAccessdate As String
Try
regKey = Registry.LocalMachine.OpenSubKey("Software\AppSecurity", True)
StartDate = Format(Today, "dd/MM/yyyy")
LastDate = Format(Today.AddDays(TrialPeriod), "dd/MM/yyyy")
FinalDate = funcEncrpt_Date(StartDate) & ";" & funcEncrpt_Date(LastDate)
regKey.SetValue("System_In", FinalDate)
SaveFirstAccessdate = Format(Today, "dd/MM/yyyy") & ";" & Format(TimeOfDay, "hh:mm:ss tt")
regKey.SetValue("System_Used", funcEncrpt_Date(SaveFirstAccessdate))
regKey.SetValue("AppName", "AppSecurity")
regKey.Close()
Return True
Catch ex As Exception
Return False
End Try
End Function
Public Function GetLastAccessDateTime() As String
Try
Dim regKey As RegistryKey
regKey = Registry.LocalMachine.OpenSubKey("SOFTWARE", True)
Dim LastAccess As String
regKey = Registry.LocalMachine.OpenSubKey("Software\AppSecurity", True)
LastAccess = regKey.GetValue("System_Used")
If LastAccess = "" Or LastAccess.Length <> "22" Then
Return "You have change some module,you are un-authorised to use the application."
Else
Dim TodayDate As String
TodayDate = (Format(Today, "dd/MM/yyyy") & ";" & Format(TimeOfDay, "hh:mm:ss tt"))
If TodayDate < funcDecrpt_Date(LastAccess) Then
Return "You have change your system Date mannually,you are un-authorised to use the application."
Else
Return "LogIn"
End If
End If
regKey.Close()
Catch ex As Exception
Return ""
End Try
End Function
Public Sub SaveLastAceessDateTime()
Try
Dim regKey As RegistryKey
regKey = Registry.LocalMachine.OpenSubKey("SOFTWARE", True)
Dim SaveLastAccessdate As String
regKey = Registry.LocalMachine.OpenSubKey("Software\AppSecurity", True)
SaveLastAccessdate = Format(Today, "dd/MM/yyyy") & ";" & Format(TimeOfDay, "hh:mm:ss tt")
FinalDateTime = funcEncrpt_Date(SaveLastAccessdate)
regKey.SetValue("System_Used", FinalDateTime)
regKey.Close()
Catch ex As Exception
End Try
End Sub
Public Function DisplayApplicationStatus(ByVal pDaysSystem_Used As Integer, ByVal pTotalDays As Integer) As String
If pTotalDays < 0 Then
Return "An error has occurred! The author has alloted you a trial period less than zero days, which is impossible. Please contact the author and tell him/her of this error."
End If
If pDaysSystem_Used >= pTotalDays Then
Return "Your trial has expired!"
End If
RemainsDays1 = pTotalDays - pDaysSystem_Used
Return "You have " + (pTotalDays - pDaysSystem_Used).ToString + " days remaining in your free trial period."
End Function
Public Function DiffDate(ByVal OrigDay As String, ByVal OrigMonth As String, ByVal OrigYear As String) As Integer
Try
Dim D1 As Date = New Date(Convert.ToInt32(OrigYear), Convert.ToInt32(OrigMonth), Convert.ToInt32(OrigDay))
Return Convert.ToInt32(DateDiff(DateInterval.Day, D1, DateTime.Now))
Catch
Return 0
End Try
End Function
Private Sub Btnclose_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Btnclose.Click
If MessageBox.Show("Are you sure,you want to Exit application.", "Exit", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
Dim obj As New RegistryTrial
obj.SaveLastAceessDateTime()
Me.Close()
Else
Me.Show()
End If
End Sub
Private Sub RegistryTrial_Load_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim obj As New RegistryTrial
Dim str As String = obj.Regedit(1830)
If str = Nothing Then
Me.Close()
Else
If str.StartsWith("123") = True Then
MsgBox(str.Substring(3), MsgBoxStyle.Information, "Information")
If Me.MdiChildren.Length > 0 Then
Exit Sub
End If
Else
MsgBox(str, MsgBoxStyle.Critical, "Error")
End
End If
End If
End Sub
End Class