Visual Basic - generar clave en visual basic

Life is soft - evento anual de software empresarial
   
Vista:

generar clave en visual basic

Publicado por FRANCISCO (1 intervención) el 25/09/2015 18:32:13
Tengo un programa que compre hace años, pero para que trabaje tengo que poner contraseña generada mediante codigo del disco duro. Y no se como funciona este es lo que trae..

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
' 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)
'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

gracias por su ayuda
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder