'在网上找了这代码!自己试了能运行,但是这注册的方法和注册机就搞不懂了!
借机会向各位请教下!
' "该代码（作者：闵锐 蒋锦霞） "
Private Declare Function GetVolumeInformation Lib "kernel32 " Alias "GetVolumeInformationA " (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long Private Declare Function GetPrivateProfileString Lib "kernel32 " Alias "GetPrivateProfileStringA " (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long Private Declare Function WritePrivateProfileString Lib "kernel32 " Alias "WritePrivateProfileStringA " (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long Dim n As Integer
Dim registry As String * 255
Dim inifilename As String
Function GetSerialNumber(strDrive As String) As Long
Dim SerialNum As Long '注释：定义序列号
Dim Res As Long
Dim Temp1 As String
Dim Temp2 As String
Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0)) Res = GetVolumeInformation(strDrive, Temp1, Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
GetSerialNumber = SerialNum
End Function
Private Sub Command1_Click()
Text3.Text = GetSerialNumber( "c:\ ") '注释：取C分区的硬盘序列号
Dim test As New Password '注释：定义新的加密类
Dim r_string As String
Dim temp As String
Dim registry_string As String
registry_string = Text3.Text
'注释: 操作读写ini文件的API函数
Call WritePrivateProfileString( "mouselock ", "registry ", registry_string, inifilename)
r_string = Text2.Text
temp = test.crypt( "D ", registry_string, r_string)
If Text1.Text = " " Then
MsgBox "必须输入用户名! ", , "注册 "
End
End If
If temp <> (Text1.Text + "i ") Then '注释: 设置区分码
MsgBox "你应该找作者注册，共享软件凝聚着作者的血和汗. ", , "注册 " " "
Else
MsgBox "谢谢使用本软件! ", , "注册 "
Dim registry_string1 As String
registry_string1 = "tttt " '注释：加入注册的标记并保存于ini文件中，可以自己设定
'注释: 调用Windows的API函数来读写ini文件
Call WritePrivateProfileString( "mouselock ", "reg ", registry_string1, inifilename)
Form1.show '注释: 调用自己的应用程序
Unload Me '注释：关闭注册程序
End If
Text3.Visible = True
Label4.Visible = True
Label5.Visible = True
Label6.Visible = True
End Sub
Private Sub Command2_Click()
Form1.show '注释: 运行你的共享软件主程序
Unload Me '注释：关闭注册程序
End Sub
Private Sub Form_Load()
Form25.Caption = "Microsoft Visual Basic6.0 " '注释：此处可以改为你的共享软件名
Text3.Visible = False
Label4.Visible = False
Label5.Visible = False
Label6.Visible = False
End Sub '该段代码放在类模块中
Option Explicit
Function crypt(Action As String, Key As String, Src As String) As String
Dim Count As Integer, KeyPos As Integer, KeyLen As Integer, SrcAsc As Integer, dest As String, offset As Integer, TmpSrcAsc, SrcPos
KeyLen = Len(Key)
If Action = "E " Then
Randomize
offset = (Rnd * 10000 Mod 255) + 1
dest = Hex$(offset)
If Len(dest) = 1 Then
dest = "0 " + dest
End If
For SrcPos = 1 To Len(Src)
SrcAsc = (Asc(Mid$(Src, SrcPos, 1)) + offset) Mod 255
If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else KeyPos = 1
SrcAsc = SrcAsc Xor Asc(Mid$(Key, KeyPos, 1))
dest = dest + Format$(Hex$(SrcAsc), "@@ ")
offset = SrcAsc
Next
ElseIf Action = "D " Then
offset = Val( "&H " + Left$(Src, 2))
For SrcPos = 3 To Len(Src) Step 2
SrcAsc = Val( "&H " + Trim(Mid$(Src, SrcPos, 2)))
If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else KeyPos = 1
TmpSrcAsc = SrcAsc Xor Asc(Mid$(Key, KeyPos, 1))
If TmpSrcAsc <= offset Then
TmpSrcAsc = 255 + TmpSrcAsc - offset
Else
TmpSrcAsc = TmpSrcAsc - offset
End If
dest = dest + Chr(TmpSrcAsc)
offset = SrcAsc
Next
End If
crypt = dest
End Function
'这是注册机的代码,就看不懂为什么加了4个TextBox控件..... 他们是起到什么作用呢.....
Private Sub Command1_Click()
Dim ppp As New Password '注释：定义一个型的类
'注释: 定义明码?暗码?密匙?及区分码
Dim D_string As String
Dim E_string As String
Dim Qf_string As String
Dim MC_string As String
D_string = Text1.Text
Qf_string = Text2.Text
MC_string = Text3.Text
'注释: 加密
If Text2.Text = "" Then
E_string = ppp.crypt("E", MC_string, D_string)
Else
D_string = D_string + Qf_string
E_string = ppp.crypt("E", MC_string, D_string)
End If
Text4.Text = E_string
End Sub
Private Sub Form_Load()
Form1.Caption = "注册器"
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
End Sub
哦!!那么说在4个TextBox中都得输入注册码啊!!!
输入几个多长都可以
Text2.Text '附加码
Text3.Text '明文
Text4.Text '密文