Hi people i need help creating a serial key for the following activation key, heres the code of how the program gets the activation key, any help would be highly appreciated
Imports System.IO
Imports System.Management.Instrumentation
Module ModReg
#Region "API Calls"
Private Declare Unicode Function WritePrivateProfileString Lib "kernel32" _
Alias "WritePrivateProfileStringW" (ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal lpString As String, _
ByVal lpFileName As String) As Int32
Private Declare Unicode Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringW" (ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Int32, _
ByVal lpFileName As String) As Int32
#End Region
Public mfRegistered As Boolean
Public lsKey As String
Public lsSerial As String
Public lsIniFile As String
Public loFiles As FileStream = Nothing
Public Function INIRead(ByVal INIPath As String, _
ByVal SectionName As String, ByVal KeyName As String, _
ByVal DefaultValue As String) As String
Dim n As Int32
Dim sData As String
sData = Space$(1024)
n = GetPrivateProfileString(SectionName, KeyName, DefaultValue, _
sData, sData.Length, INIPath)
If n > 0 Then
INIRead = sData.Substring(0, n)
Else
INIRead = ""
End If
End Function
Public Function GetMacAddress() As String
Dim lsMacAddress As String = ""
For Each nic As System.Net.NetworkInformation.NetworkInterface In System.Net.NetworkInformation.NetworkInterface.GetAllNetworkInterfaces()
If Len(String.Format("{1}{2}", nic.Description, "", nic.GetPhysicalAddress())) > 0 Then
If InStr(lsMacAddress, String.Format("{1}{2}", nic.Description, "", nic.GetPhysicalAddress())) = 0 Then
lsMacAddress = lsMacAddress & (String.Format("{1}{2}", nic.Description, "", nic.GetPhysicalAddress()))
End If
End If
Next
Return lsMacAddress
End Function
Public Sub INIWrite(ByVal INIPath As String, ByVal SectionName As String, _
ByVal KeyName As String, ByVal TheValue As String)
Call WritePrivateProfileString(SectionName, KeyName, TheValue, INIPath)
End Sub
Public Sub INIDelete(ByVal INIPath As String, ByVal SectionName As String, _
ByVal KeyName As String)
Call WritePrivateProfileString(SectionName, KeyName, Nothing, INIPath)
End Sub
Public Sub check1()
If File.Exists(System.AppDomain.CurrentDomain.BaseDirectory.ToString & "\" & "winreg.ini") = False Then
MsgBox("Registry file does not exist on this computer. The Application will shut down!")
frmSubject.Close()
TerminateSystem()
End If
End Sub
Public Function GetKey(ByVal psKey As String) As String
Dim lsKey As String = ""
Dim lsK1 As String = ""
Dim lsK2 As String = ""
Dim lsK3 As String = ""
Dim lsK4 As String = ""
Dim lsCalcSerail As String = ""
lsCalcSerail = base64Decode(psKey)
If Len(lsCalcSerail) > 0 Then
lsK1 = Mid(lsCalcSerail, Len(lsCalcSerail) / 3, 3)
lsK2 = Mid(lsCalcSerail, Len(lsCalcSerail) / 5, 3)
lsK3 = Mid(lsCalcSerail, Len(lsCalcSerail) / 2, 3)
lsK4 = Mid(lsCalcSerail, 3, 1) & Mid(lsCalcSerail, Len(lsCalcSerail) / 4, 1) & Mid(lsCalcSerail, Len(lsCalcSerail) - 1, 1)
Return lsK1 & "-" & lsK2 & "-" & lsK3 & "-" & lsK4
End If
Return ""
End Function
Public Function base64Encode(ByVal sData As String) As String
Try
Dim encData_byte As Byte() = New Byte(sData.Length - 1) {}
encData_byte = System.Text.Encoding.UTF8.GetBytes(sData)
Dim encodedData As String = Convert.ToBase64String(encData_byte)
Return (encodedData)
Catch ex As Exception
Throw (New Exception("Error in base64Encode " & ex.Message))
End Try
End Function
Public Function base64Decode(ByVal sData As String) As String
Try
Dim encoder As New System.Text.UTF8Encoding()
Dim utf8Decode As System.Text.Decoder = encoder.GetDecoder()
Dim todecode_byte As Byte() = Convert.FromBase64String(sData)
Dim charCount As Integer = utf8Decode.GetCharCount(todecode_byte, 0, todecode_byte.Length)
Dim decoded_char As Char() = New Char(charCount - 1) {}
utf8Decode.GetChars(todecode_byte, 0, todecode_byte.Length, decoded_char, 0)
Dim result As String = New [String](decoded_char)
Return (result)
Catch ex As Exception
Throw (New Exception("Error in base64Decode " & ex.Message))
End Try
End Function
Public Sub Main()
lsIniFile = System.AppDomain.CurrentDomain.BaseDirectory.ToString & "\" & "winreg.ini"
Loaddetail()
End Sub
Public Sub Loaddetail()
If INIRead(lsIniFile, "Register", "Key", "") = "" Then
lsKey = base64Encode(GetMacAddress())
INIWrite(lsIniFile, "Register", "Key", lsKey)
End If
lsKey = INIRead(lsIniFile, "Register", "Key", "")
lsSerial = INIRead(lsIniFile, "Register", "Serial", "")
If lsKey <> base64Encode(GetMacAddress()) Then
mfRegistered = False
lsKey = base64Encode(GetMacAddress())
INIWrite(lsIniFile, "Register", "Key", lsKey)
lsSerial = ""
Else
mfRegistered = False
End If
If lsSerial <> GetKey(lsKey) Then
mfRegistered = False
lsKey = base64Encode(GetMacAddress())
INIWrite(lsIniFile, "Register", "Key", lsKey)
lsSerial = ""
Else
mfRegistered = False
End If
If mfRegistered = False Then
SetupConnection()
frmSplash.ShowDialog()
Else
frmReg.lblStatus.Text = "Un-Registered Application. Please contact the administrator."
frmReg.txtActCode.Text = lsKey
frmReg.txtActKey.Text = lsSerial
frmReg.ShowDialog()
End If
End Sub
End Module
[edit]Code block added - OriginalGriff[/edit]