用户名ASCII值加和,再与位数相除,余数与加和后数值再加和到个位数后值相乘,两值相接,如kevinch的ASCII加和为744,加和到个位数(R1)为7+4+4=15,1+5=6,与位数相除的余数(R2)即744 mod 7 =2,R1*R2=2*6=12,于是要提取的序列为74412,序列号长度为R1*R2=12
再依奇偶序从33-126之间累加或累减得到序列号
Private Sub Command1_Click()
x = Text1.Text
Text2.Text = ""
If Len(x) < 2 Then
msg = MsgBox("请输入2位以上的用户名", vbOKOnly)
GoTo quit
End If
ulen = Len(x)
utotal = 0
For i1 = 1 To ulen
utotal = utotal + Asc(Mid(x, i1, 1)) '用户名ASCII值加和
Next i1
utotal2 = utotal
If utotal2 Mod 10 = 0 And ulen Mod 10 = 0 Then '如果加和除以位数后为零则置为10
r1 = 10
Else
r1 = utotal2 Mod ulen '否则取余数
End If
If r1 = 0 Then r1 = 10 '再加上个保险
again:
r2 = 0
For i2 = 1 To Len(utotal2)
r2 = r2 + Int(utotal2 / 10 ^ (Len(utotal2) - i2)) Mod 10 '取各位累加和
Next i2
If r2 > 9 Then
utotal2 = r2
GoTo again
End If
r4 = r1 * r2
If r4 < 8 Then r4 = 8 '后加的让序列号最少8位
if len(text.text2) <> r4 then unload me '位数不对出错是这里,可是我还真不明白是什么原因出的错,不能用unload me吗???
r3 = utotal * 10 ^ Len(r1 * r2) + r1 * r2
Dim list As String
result = 0
tmp1 = 32 '因为可输入字符是从ASCII值33-126之间
tmp2 = 127
For i6 = 1 To r4
If i6 Mod 2 = 0 Then '如果I6是偶数就由ASCII值32向上累加
tmp1 = tmp1 + Int(r3 / 10 ^ (i6 Mod Len(r3))) Mod 10
If tmp1 > 126 Then tmp1 = tmp1 - 126 + 32 '高于126后再折回来
tmp = tmp1
Else '如果是奇数就从ASCII值127向下累减
tmp2 = tmp2 - Int(r3 / 10 ^ (i6 Mod Len(r3))) Mod 10
If tmp2 < 33 Then tmp2 = 127 - 33 + tmp2 '低于33后再返回去
tmp = tmp2
End If
result = result + tmp - asc(mid(text.text2, i6, 1))
Rem msg = MsgBox(list, vbOKOnly)
list = list + Chr(tmp) '就是这句没有REM掉
Next i6
if result=0 then msg=msgbox("你真厉害",vbokonly,"成功啦") '这句换成text.text2=list就可以做注册机了
quit:
End Sub
