帮助！！为以下代码创建激活密钥 [英] help!! creating an activation key for the following code

问题描述

我需要为以下激活密钥创建序列密钥的帮助，以下是程序如何获取激活密钥的代码，我们将不胜感激任何帮助

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"
    ' standard API declarations for INI access
    ' changing only "As Long" to "As Int32" (As Integer would work also)
    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
        ' primary version of call gets single value given all parameters
        Dim n As Int32
        Dim sData As String
        sData = Space$(1024) ' allocate some room 
        n = GetPrivateProfileString(SectionName, KeyName, DefaultValue, _
        sData, sData.Length, INIPath)
        If n > 0 Then ' return whatever it gave us
            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) ' delete single line from section
        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()
        ' Try
        lsIniFile = System.AppDomain.CurrentDomain.BaseDirectory.ToString & "\" & "winreg.ini"
        Loaddetail()
        'Catch ex As Exception
        '    MsgBox("Error in Sub Main " & ex.Message) 'if database is open in design mode
        'End Try
    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]已添加代码块-OriginalGriff [/edit]

[edit]Code block added - OriginalGriff[/edit]

推荐答案

( 1024 )' 分配一些空间 n = GetPrivateProfileString(SectionName，KeyName，DefaultValue，_ sData，sData.Length，INIPath) 如果 n> 0 然后 ' 0 ，n) 其他 INIRead = " 结束 如果 结束 功能 公共 功能 GetMacAddress() As 字符串 Dim lsMacAddress As 字符串 = " 对于 每个 nic As System.Net. NetworkInformation.NetworkInterface 在中System.Net.NetworkInformation.NetworkInterface.GetAllNetworkInterfaces() 如果 Len(字符串 .Format(" {1} {2}"，nic.Description， "，nic.GetPhysicalAddress()))> 0 然后 如果 InStr(lsMacAddress，字符串 .Format(" {1} {2}"，nic.Description， ，nic.GetPhysicalAddress()))= 0 然后 lsMacAddress = lsMacAddress& (字符串 .Format(" ，nic.Description， "，nic.GetPhysicalAddress())) 结束 如果 结束 如果 下一步 返回 lsMacAddress 结束 功能 公共 子 INIWrite( ByVal INIPath As 字符串， ByVal SectionName 字符串，_ ByVal KeyName As 字符串， ByVal TheValue As String ) 调用 WritePrivateProfileString(SectionName，KeyName，TheValue，INIPath) 结束 子 公共 子 INIDelete( ByVal INIPath As 字符串， ByVal SectionName 字符串，_ ByVal KeyName As String )' 从部分中删除单行 调用 WritePrivateProfileString(SectionName，KeyName，没什么，INIPath) 结束 子 公共 Sub check1() 如果 File.Exists(System.AppDomain.CurrentDomain.BaseDirectory.ToString& " & " )= 错误 然后 MsgBox(" ) frmSubject.Close() TerminateSystem() 结束 如果 结束 子 公共 功能 GetKey( ByVal psKey As 字符串) As Dim lsKey As 字符串 = " Dim lsK1 As 字符串 = " Dim lsK2 As 字符串 = " Dim lsK3 As 字符串 = " Dim lsK4 As 字符串 = " Dim lsCalcSerail As 字符串 = " lsCalcSerail = base64Decode(psKey)' ' 如果 Len(lsCalcSerail)> 0 然后 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 )&中(lsCalcSerail，Len(lsCalcSerail)- 1 ， 1 ) 返回 lsK1& " & lsK2和" & lsK3& " & lsK4 结束 如果 返回 " 结束 功能 公共 函数 base64Encode( ByVal sData As 字符串) As 尝试 Dim encData_byte As Byte ()= 新建 字节(sData.Length- 1 ) {} encData_byte = System.Text.Encoding.UTF8.GetBytes(sData) Dim encodeData As String = Convert.ToBase64String (encData_byte) 返回(encodedData) 捕获，例如 As 异常 抛出(新异常(" base64Encode中的错误"& ex.Message)) 结束 尝试 结束 功能 公共 功能 base64Decode( ByVal sData As 字符串) As 尝试 Dim 编码器 As New System.Text. UTF8Encoding() Dim utf8Decode As System.Text.Decoder = encoder.GetDecoder() Dim todecode_byte As Byte ()=转换.FromBase64String(sData) Dim charCount As 整数 = utf8Decode.GetCharCount (todecode_byte， 0 ，todecode_byte.Length) Dim encoded_char As Char ()= 新建 Char (charCount- 1 ){} utf8Decode.GetChars(todecode_byte， 0 ，todecode_byte.Length，decoded_char， 0 ) Dim 结果 As 字符串 = 新建 [字符串](已解码字符) 返回(结果) 捕获，例如 As 异常 抛出(新异常(" base64Decode中的错误"& ex.Message)) 结束 尝试 结束 功能 公共 Sub Main() ' 尝试 lsIniFile = System.AppDomain.CurrentDomain.BaseDirectory.ToString& " & " Loaddetail() ' 异常捕获 ' MsgBox("Sub Main中的错误"& ex.Message)'如果数据库以设计模式打开 ' 结束尝试 结束 子 公共 Sub Loaddetail() 如果 INIRead(lsIniFile，" ，" ，" ")= " " ，" 密钥"，lsKey) 结束 如果 lsKey = INIRead(lsIniFile，" ，" 键"， " ) lsSerial = INIRead(lsIniFile，" ，" 序列"， " ) 如果 lsKey<> base64Encode(GetMacAddress())然后 mfRegistered = 错误 lsKey = base64Encode(GetMacAddress()) INIWrite(lsIniFile，" ，" 密钥"，lsKey) lsSerial = " 其他 mfRegistered = 错误 结束 如果 如果 lsSerial<> GetKey(lsKey)然后 mfRegistered = 错误 lsKey = base64Encode(GetMacAddress()) INIWrite(lsIniFile，" ，" 密钥"，lsKey) lsSerial = " 其他 mfRegistered = 错误 结束 如果 如果 mfRegistered = 错误 然后 建立连接() frmSplash.ShowDialog() 其他 frmReg.lblStatus.Text = " frmReg.txtActCode.Text = lsKey frmReg.txtActKey.Text = lsSerial frmReg.ShowDialog() 结束 如果 结束 子 结束 模块

(1024) ' allocate some room n = GetPrivateProfileString(SectionName, KeyName, DefaultValue, _ sData, sData.Length, INIPath) If n > 0 Then ' return whatever it gave us 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) ' delete single line from section 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() ' Try lsIniFile = System.AppDomain.CurrentDomain.BaseDirectory.ToString & "\" & "winreg.ini" Loaddetail() 'Catch ex As Exception ' MsgBox("Error in Sub Main " & ex.Message) 'if database is open in design mode 'End Try 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]已添加代码块-OriginalGriff [/edit]

[edit]Code block added - OriginalGriff[/edit]

这篇关于帮助！！为以下代码创建激活密钥的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！