回复 7# backboy 的帖子
已经发现了，谢谢指点！附件中添加了说明了
努力再修正看看。 看看！！！ 学习下！ 楼主太牛了，支持，并学习一下 我什么时候能象您一样有水平就好了 见过52斑竹破解过这个软件 我也试试 已经克服了中文名字和姓名位数的限制。
当然要防止VB的溢出。
请大家试用，在实践中检验，我将及时更正！
谢谢！！！
VB源码：
Option Base 1
Private Sub Command1_Click()
Dim int1(5)
Dim str1(100)
Dim sn(4)
Dim sn1 As Long
Txt1 = Text1.Text
For i = 1 To Len(Txt1)
str4 = Hex(Asc(Mid(Txt1, i, 1)))
str5 = str5 & str4
Next
i = 0
For s = 1 To Len(str5) Step 2
i = i + 1
str1(i) = Mid(str5, s, 2)
Next
t = Len(str5) / 2
For i = 1 To t
Hex2 = str1(i)
For n = 1 To Len(Hex2)
Select Case Mid(Hex2, Len(Hex2) - n + 1, 1)
Case "0": x = x + 16 ^ (n - 1) * 0
Case "1": x = x + 16 ^ (n - 1) * 1
Case "2": x = x + 16 ^ (n - 1) * 2
Case "3": x = x + 16 ^ (n - 1) * 3
Case "4": x = x + 16 ^ (n - 1) * 4
Case "5": x = x + 16 ^ (n - 1) * 5
Case "6": x = x + 16 ^ (n - 1) * 6
Case "7": x = x + 16 ^ (n - 1) * 7
Case "8": x = x + 16 ^ (n - 1) * 8
Case "9": x = x + 16 ^ (n - 1) * 9
Case "A": x = x + 16 ^ (n - 1) * 10
Case "B": x = x + 16 ^ (n - 1) * 11
Case "C": x = x + 16 ^ (n - 1) * 12
Case "D": x = x + 16 ^ (n - 1) * 13
Case "E": x = x + 16 ^ (n - 1) * 14
Case "F": x = x + 16 ^ (n - 1) * 15
End Select
Next n
str1(i) = x
x = 0
Next
'上面是将姓名的ASCII转为十六进制，再转为十进制，是因为中文字符的ASCII码的十六进制很明确，直
接转十进制的有误。
'第一次循环
int1(1) = &HAA
int1(2) = &H89
int1(3) = &HC4
int1(4) = &HFE
int1(5) = &H46
a = 0
For i = 1 To t
a = a + 1
int2 = int1(a)
int1(a) = str1(i)
str1(i) = str1(i) Xor int2
If a >= 5 Then
a = a - 5
End If
Next
'第二次循环
int1(1) = &H78
int1(2) = &HF0
int1(3) = &HD0
int1(4) = &H3
int1(5) = &HE7
a = 0
For i = t To 1 Step -1
a = a + 1
int2 = int1(a)
int1(a) = str1(i)
str1(i) = str1(i) Xor int2
If a >= 5 Then
a = a - 5
End If
Next
'第三次循环
int1(1) = &HF7
int1(2) = &HFD
int1(3) = &HF4
int1(4) = &HE7
int1(5) = &HB9
a = 0
For i = 1 To t
a = a + 1
int2 = int1(a)
int1(a) = str1(i)
str1(i) = str1(i) Xor int2
If a >= 5 Then
a = a - 5
End If
Next
'第四次循环
int1(1) = &HB5
int1(2) = &H1B
int1(3) = &HC9
int1(4) = &H50
int1(5) = &H73
a = 0
For i = t To 1 Step -1
a = a + 1
int2 = int1(a)
int1(a) = str1(i)
str1(i) = str1(i) Xor int2
If a >= 5 Then
a = a - 5
End If
Next
'整合出注册码
m = 0
For i = 1 To t
m = m + 1
sn(m) = sn(m) + str1(i)
If m = 4 Then
m = m - 4
End If
Next
For m = 1 To 4
sn2 = Hex(sn(m))
If Len(sn2) < 2 Then '因为考虑到注册码是四个字符相连而成，为了防止有少于或多于两个字符
的
sn2 = "0" & sn2
End If
If Len(sn2) > 2 Then
sn2 = Right(sn2, 2)
End If
sn3 = sn2 & sn3
Next
hex1 = sn3
For i = 1 To Len(hex1)
Select Case Mid(hex1, Len(hex1) - i + 1, 1)
Case "0": b = b + 16 ^ (i - 1) * 0
Case "1": b = b + 16 ^ (i - 1) * 1
Case "2": b = b + 16 ^ (i - 1) * 2
Case "3": b = b + 16 ^ (i - 1) * 3
Case "4": b = b + 16 ^ (i - 1) * 4
Case "5": b = b + 16 ^ (i - 1) * 5
Case "6": b = b + 16 ^ (i - 1) * 6
Case "7": b = b + 16 ^ (i - 1) * 7
Case "8": b = b + 16 ^ (i - 1) * 8
Case "9": b = b + 16 ^ (i - 1) * 9
Case "A": b = b + 16 ^ (i - 1) * 10
Case "B": b = b + 16 ^ (i - 1) * 11
Case "C": b = b + 16 ^ (i - 1) * 12
Case "D": b = b + 16 ^ (i - 1) * 13
Case "E": b = b + 16 ^ (i - 1) * 14
Case "F": b = b + 16 ^ (i - 1) * 15
End Select
Next i
sn3 = b
Text2.Text = sn3
End Sub 原帖由 萧萧黄叶 于 2009-3-4 20:46 发表 https://www.chinapyg.com/images/common/back.gif
已经克服了中文名字和姓名位数的限制。
当然要防止VB的溢出。
请大家试用，在实践中检验，我将及时更正！
谢谢！！！
VB源码：
Option Base 1
Private Sub Command1_Click()
Dim int1(5)
Dim str1(100)
D ...
Goog Job ~~ 支持，并学习一下 这回没问题了,再顶!楼主潜力无限/:good
页:
1
[2]