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)