Lo que deseo es con el codigo escrito es hacer un keygen para crear un codigo de activacion. Como el de la imagen. El numero de maquina es el codigo ISATAP de la Tarjeta de Red y como se sabe es unico para cada Pc, entonces ese codigo es el que lo cifra y como resultado debe darme el codigo de activacion.
Código [Seleccionar]
[color=green]Public Function EncriptarCadena(ByVal cadena As String) As String[/color]
Dim str As String
Dim num4 As Integer
Try
Dim str2 As String
Dim num5 As Integer
Label_0001:
ProjectData.ClearProjectError
Dim num3 As Integer = 2
Label_0009:
num5 = 2
Dim num2 As Integer = Strings.Len(cadena)
Dim num As Integer = 1
goto Label_003E
Label_0017:
num5 = 3
str2 = (str2 & Me.EncriptarCaracter(Strings.Mid(cadena, num, 1), Strings.Len(cadena), num))
Label_0036:
num5 = 4
num += 1
Label_003E:
If (num <= num2) Then
goto Label_0017
End If
Label_0046:
num5 = 5
str = str2
goto Label_010F
Label_0053:
num5 = 7
Interaction.MsgBox(Information.Err.Description, MsgBoxStyle.ApplicationModal, Nothing)
Label_0068:
num5 = 8
ProjectData.ClearProjectError
If (num4 = 0) Then
Throw ProjectData.CreateProjectError(-2146828268)
End If
Label_008E:
num4 = 0
Select Case (num4 + 1)
Case 1
goto Label_0001
Case 2
goto Label_0009
Case 3
goto Label_0017
Case 4
goto Label_0036
Case 5
goto Label_0046
Case 6, 9
goto Label_010F
Case 7
goto Label_0053
Case 8
goto Label_0068
Case Else
goto Label_0104
End Select
Label_00C0:
num4 = num5
Select Case If((num3 > -2), num3, 1)
Case 0
goto Label_0104
Case 1
goto Label_008E
Case 2
goto Label_0053
End Select
Catch obj1 As Object When (?)
ProjectData.SetProjectError(DirectCast(obj1, Exception))
goto Label_00C0
End Try
Label_0104:
Throw ProjectData.CreateProjectError(-2146828237)
Label_010F:
If (num4 <> 0) Then
ProjectData.ClearProjectError
End If
Return str
End Function
[color=green]Private Function EncriptarCaracter(ByVal caracter As String, ByVal variable As Integer, ByVal a_indice As Integer) As String[/color]
Dim str2 As String
Dim num3 As Integer
Try
Dim num4 As Integer
Label_0001:
ProjectData.ClearProjectError
Dim num2 As Integer = 2
Label_0008:
num4 = 2
If (Strings.InStr(Me.patron_busqueda, caracter, CompareMethod.Binary) = 0) Then
goto Label_0068
End If
Label_0024:
num4 = 3
Dim start As Integer = (((Strings.InStr(Me.patron_busqueda, caracter, CompareMethod.Binary) + variable) + a_indice) Mod Strings.Len(Me.patron_busqueda))
Label_0045:
num4 = 4
If (start = 0) Then
goto Label_0068
End If
Label_0055:
num4 = 5
Dim str As String = Strings.Mid(Me.Patron_encripta, start, 1)
Label_0068:
num4 = 8
str2 = str
goto Label_013C
Label_0075:
num4 = 10
Interaction.MsgBox(Information.Err.Description, MsgBoxStyle.ApplicationModal, Nothing)
Label_008B:
num4 = 11
ProjectData.ClearProjectError
If (num3 = 0) Then
Throw ProjectData.CreateProjectError(-2146828268)
End If
Label_00B2:
num3 = 0
Select Case (num3 + 1)
Case 1
goto Label_0001
Case 2
goto Label_0008
Case 3
goto Label_0024
Case 4
goto Label_0045
Case 5
goto Label_0055
Case 6, 7, 8
goto Label_0068
Case 9, 12
goto Label_013C
Case 10
goto Label_0075
Case 11
goto Label_008B
Case Else
goto Label_0131
End Select
Label_00F0:
num3 = num4
Select Case If((num2 > -2), num2, 1)
Case 0
goto Label_0131
Case 1
goto Label_00B2
Case 2
goto Label_0075
End Select
Catch obj1 As Object When (?)
ProjectData.SetProjectError(DirectCast(obj1, Exception))
goto Label_00F0
End Try
Label_0131:
Throw ProjectData.CreateProjectError(-2146828237)
Label_013C:
If (num3 <> 0) Then
ProjectData.ClearProjectError
End If
Return str2
End Function
[color=green]Private Function GeneradorClave(ByVal strSerie As String, ByVal strNumeroMaquina As String) As String[/color]
Dim str As String
Dim num2 As Integer
Try
Dim num3 As Integer
Label_0001:
ProjectData.ClearProjectError
Dim num As Integer = 2
Label_0008:
num3 = 2
Me.patron_busqueda = "FWDXV8ZIJRKY6ÑUT95A1Q23C4SM0BNRELGOPH7"
Label_0015:
num3 = 3
Me.Patron_encripta = "LKVCÑRXI1E3TY58GR6PAQ4JUZ2HNDO79MSBWF0"
Label_0022:
num3 = 4
str = Me.EncriptarCadena((strSerie & strNumeroMaquina))
goto Label_00E3
Label_003A:
num3 = 6
Interaction.MsgBox(Information.Err.Description, MsgBoxStyle.ApplicationModal, Nothing)
Label_004E:
num3 = 7
ProjectData.ClearProjectError
If (num2 = 0) Then
Throw ProjectData.CreateProjectError(-2146828268)
End If
Label_006D:
num2 = 0
Select Case (num2 + 1)
Case 1
goto Label_0001
Case 2
goto Label_0008
Case 3
goto Label_0015
Case 4
goto Label_0022
Case 5, 8
goto Label_00E3
Case 6
goto Label_003A
Case 7
goto Label_004E
Case Else
goto Label_00D8
End Select
Label_009A:
num2 = num3
Select Case If((num > -2), num, 1)
Case 0
goto Label_00D8
Case 1
goto Label_006D
Case 2
goto Label_003A
End Select
Catch obj1 As Object When (?)
ProjectData.SetProjectError(DirectCast(obj1, Exception))
goto Label_009A
End Try
Label_00D8:
Throw ProjectData.CreateProjectError(-2146828237)
Label_00E3:
If (num2 <> 0) Then
ProjectData.ClearProjectError
End If
Return str
End Function
[color=green]Public Function DesEncriptarCadena(ByVal cadena As String) As String[/color]
Dim str2 As String
Dim num2 As Integer = Strings.Len(cadena)
Dim i As Integer = 1
Do While (i <= num2)
str2 = (str2 & Me.DesEncriptarCaracter(Strings.Mid(cadena, i, 1), Strings.Len(cadena), i))
i += 1
Loop
Return str2
End Function
[color=green]Private Function DesEncriptarCaracter(ByVal caracter As String, ByVal variable As Integer, ByVal a_indice As Integer) As String[/color]
Dim num As Integer
If (Strings.InStr(Me.Patron_encripta, caracter, CompareMethod.Binary) = 0) Then
Return caracter
End If
If (((Strings.InStr(Me.Patron_encripta, caracter, CompareMethod.Binary) - variable) - a_indice) > 0) Then
num = (((Strings.InStr(Me.Patron_encripta, caracter, CompareMethod.Binary) - variable) - a_indice) Mod Strings.Len(Me.Patron_encripta))
Else
num = (Strings.Len(Me.patron_busqueda) + (((Strings.InStr(Me.Patron_encripta, caracter, CompareMethod.Binary) - variable) - a_indice) Mod Strings.Len(Me.Patron_encripta)))
End If
num = (num Mod Strings.Len(Me.Patron_encripta))
Return Strings.Mid(Me.patron_busqueda, num, 1)
End Function