Código:
[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