Generar clave en visual basic

Tengo un programa que compre hace años, pero para que trabaje tengo que poner contraseña gererada mediante codigo del disco duro. Y no se como funciona este es lo que trae..

' Return the disk's serial number
' as a 10-digit string.
Function GetDiskSerialNumber() As String
Static serial_number As Long

Dim volume_name As String
Dim max_component_length As Long
Dim file_system_flags As Long
Dim file_system_name As String

If serial_number = 0 Then
' Get the disk serial number.
volume_name = Space$(1024)
file_system_name = Space$(1024)
If GetVolumeInformation(vbNullString, _
volume_name, Len(volume_name), _
serial_number, _
max_component_length, file_system_flags, _
file_system_name, Len(file_system_name)) = 0 _
Then
MsgBox "Error getting system information."
GetDiskSerialNumber = 0
Exit Function
End If
End If

GetDiskSerialNumber = Invert(Right$(Format$(serial_number, "0000000000"), 10))
End Function
Private Function Invert(strng As String) ' Inversion function
Dim i As Integer
Dim tmp_txt As String

i = Len(strng)

Do Until i = 0

tmp_txt = tmp_txt & Mid(strng, i, 1)

i = i - 1
Loop

Invert = tmp_txt

End Function

Function noserie() As String
noserie = GetDiskSerialNumber() & "392353683786868"
End Function

'Function PRO(ByVal Expression As String, ByVal Password As String) As String
'On Error Resume Next
'Dim RB(0 To 255) As Integer, X As Long, Y As Long, Z As Long, Key() As Byte, ByteArray() As Byte, Temp As Byte
'If Len(Password) = 0 Then
' Exit Function
'End If
'If Len(Expression) = 0 Then
' Exit Function
'End If
'If Len(Password) > 256 Then
' Key() = StrConv(Left$(Password, 256), vbFromUnicode)
'Else
' Key() = StrConv(Password, vbFromUnicode)
'End If
'For X = 0 To 255
' RB(X) = X
'Next X
'X = 0
'Y = 0
'Z = 0
'For X = 0 To 255
' Y = (Y + RB(X) + Key(X Mod Len(Password))) Mod 256
' Temp = RB(X)
' RB(X) = RB(Y)
' RB(Y) = Temp
'Next X
'X = 0
'Y = 0
'Z = 0
'ByteArray() = StrConv(Expression, vbFromUnicode)
'For X = 0 To Len(Expression)
' Y = (Y + 1) Mod 256
' Z = (Z + RB(Y)) Mod 256
' Temp = RB(Y)
' RB(Y) = RB(Z)
' RB(Z) = Temp
' ByteArray(X) = ByteArray(X) Xor (RB((RB(Y) + RB(Z)) Mod 256))
'Next X
'PRO = StrConv(ByteArray, vbUnicode)
'End Function

Function VerificaActivacion()
Dim ws As Worksheet
Dim Clave As String

Set ws = Worksheets("DATOSEMP")
Clave = ws.Range("D24").Value
If Clave = llave("Excelente Punto de Venta 2015") Then
VerificaActivacion = True
Else
VerificaActivacion = False
End If
End Function

Function llave(permiso As String)
Dim code1 As String
Dim code2 As String
Dim code3 As String
Dim code4 As String
Dim code5 As String
Dim code11 As String
Dim code22 As String
Dim code33 As String
Dim code44 As String
Dim code55 As String
Dim Mfact As Integer
Dim i As Integer
Dim serie As String
If permiso = "Excelente Punto de Venta 2015" Then

serie = noserie()

'Split And morph
If Mid(serie, 1, 1) = 0 Then
If Mid(serie, 2, 1) = 0 Then
Mfact = Int(Val(Val(Val(Mid(serie, 3, 1)) + Val(Mid(serie, 12, 1)) + Val(Mid(serie, 24, 1)) + Val(Mid(serie, Val(Mid(serie, 3, 1)), 1))) / 4))
Else
Mfact = Int(Val(Val(Val(Mid(serie, 2, 1)) + Val(Mid(serie, 12, 1)) + Val(Mid(serie, 24, 1)) + Val(Mid(serie, Val(Mid(serie, 2, 1)), 1))) / 4))
End If
Else
Mfact = Int(Val(Val(Val(Mid(serie, 1, 1)) + Val(Mid(serie, 12, 1)) + Val(Mid(serie, 24, 1)) + Val(Mid(serie, Val(Mid(serie, 1, 1)), 1))) / 4))
End If
'Mfact = Int(Val(Val(Val(Mid(serie, 1, 1)) + Val(Mid(serie, 12, 1)) + Val(Mid(serie, 24, 1)) + Val(Mid(serie, Val(Mid(serie, 1, 1)), 1))) / 4))
code1 = Mid(iSplit(serie, Mfact, 0), 1, 5)
code2 = Mid(iSplit(serie, Mfact, 1), 1, 5)
code3 = Mid(iSplit(serie, Mfact, 2), 1, 5)
code4 = Mid(iSplit(serie, Mfact, 3), 1, 5)
code5 = Mid(iSplit(serie, Mfact, 4), 1, 5)

'Selective Inv. Proc.
If Mid(code1, 5, 1) <> 0 Then
code1 = Invert(code1)
End If
code3 = Invert(code3)
code5 = Invert(code5)

1 Respuesta

Respuesta
1

'Alpha Repla.
code1 = Replace(code1, "27", "Z3")
code1 = Replace(code1, "91", "8F")
code1 = Replace(code1, "72", "1K")
code1 = Replace(code1, "19", "PS")
code1 = Replace(code1, "56", "O1")
code1 = Replace(code1, "65", "M3")
code1 = Replace(code1, "83", "L0")
code1 = Replace(code1, "38", "E5")
code1 = Replace(code1, "01", "XD")
code1 = Replace(code1, "10", "PW")

code2 = Replace(code2, "30", "C4")
code2 = Replace(code2, "03", "UX")
code2 = Replace(code2, "55", "I8")
code2 = Replace(code2, "66", "PS")
code2 = Replace(code2, "23", "MZ")
code2 = Replace(code2, "32", "8Q")
code2 = Replace(code2, "14", "0L")
code2 = Replace(code2, "41", "XS")
code2 = Replace(code2, "74", "9U")
code2 = Replace(code2, "47", "NT")
code3 = Replace(code3, "27", "Z3")
code3 = Replace(code3, "91", "8F")
code3 = Replace(code3, "72", "1K")
code3 = Replace(code3, "19", "PS")
code3 = Replace(code3, "56", "O1")
code3 = Replace(code3, "32", "8Q")
code3 = Replace(code3, "14", "0L")
code3 = Replace(code3, "41", "XS")
code3 = Replace(code3, "74", "9U")
code3 = Replace(code3, "47", "NT")
code4 = Replace(code4, "27", "Z3")
code4 = Replace(code4, "91", "8F")
code4 = Replace(code4, "72", "1K")
code4 = Replace(code4, "19", "PS")
code4 = Replace(code4, "56", "O1")
code4 = Replace(code4, "65", "M3")
code4 = Replace(code4, "83", "L0")
code4 = Replace(code4, "38", "E5")
code4 = Replace(code4, "01", "XD")
code4 = Replace(code4, "10", "PW")
code5 = Replace(code5, "30", "C4")
code5 = Replace(code5, "03", "UX")
code5 = Replace(code5, "55", "I8")
code5 = Replace(code5, "66", "PS")
code5 = Replace(code5, "23", "MZ")
code5 = Replace(code5, "32", "8Q")
code5 = Replace(code5, "14", "0L")
code5 = Replace(code5, "41", "XS")
code5 = Replace(code5, "74", "9U")
code5 = Replace(code5, "47", "NT")
'Position Swap
code11 = code1
code22 = code2
code33 = code3
code44 = code4
code55 = code5
i = Val(Mid(serie, 1, 1))
Select Case i = Val(Mid(serie, 1, 1))
Case i = 1
code1 = code22
code2 = code44
code3 = code11
code4 = code55
code5 = code33
Case i = 2
code1 = code44
code2 = code11
code3 = code33
code4 = code22
code5 = code55
Case i = 3
code1 = code33
code2 = code11
code3 = code44
code4 = code55
code5 = code22
Case i = 4
code1 = code11
code2 = code22
code3 = code44
code4 = code55
code5 = code33
Case i = 5
code1 = code22
code2 = code44
code3 = code11
code4 = code55
code5 = code33
Case i = 6
code1 = code22
code2 = code44
code3 = code11
code4 = code55
code5 = code33
Case i = 7
code1 = code22
code2 = code44
code3 = code11
code4 = code55
code5 = code33
Case i = 8
code1 = code44
code2 = code11
code3 = code33
code4 = code22
code5 = code55
Case i = 9
code1 = code55
code2 = code11
code3 = code33
code4 = code22
code5 = code44
End Select
llave = code1 & code2 & code3 & code4 & code5
Else
llave = "Acceso indevido!"
End If
End Function

Private Function iSplit(orig As String, mFactor As Integer, Partition As Integer) As String
Dim tmp_key As String
Dim tmp_istring(0 To 5) As String

tmp_key = orig

tmp_istring(0) = Val(Mid(tmp_key, 1, 5)) * mFactor
tmp_istring(1) = Val(Mid(tmp_key, 6, 5)) * mFactor
tmp_istring(2) = Val(Mid(tmp_key, 11, 5)) * mFactor
tmp_istring(3) = Val(Mid(tmp_key, 16, 5)) * mFactor
tmp_istring(4) = Val(Mid(tmp_key, 21, 5)) * mFactor

iSplit = tmp_istring(Partition)

End Function

Ejemplo codigo de pc

9518510330

Clave generada

02125-11175-0L58Q-61980-22PW2

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas