VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 共享软件作者制作的管理软件注册的动态链接库
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:10767, 日期:2001-03-17
共享软件作者制作的管理软件注册的动态链接库



作为共享软件作者,注册码被非法公布是件令你十分头疼的事情。小弟制作了这么一个类库。希望能有所帮助。它每次在RegestCheck被执行一遍的时候生成动态的用户名及密码,并保存入注册表。但软件已经注册的话则不改变原来的注册信息。所以,盗用注册码对它是没用的。



它有三个方法,四个属性。RegestCheck用来检查您的共享软件是否注册,Regest用来注册您的共享软件。GetNamePassword是为Name,Password属性赋一个合法的值。Regested 属性是保存共享软件是否注册过的信息的。RegestedKey是您的软件在注册表LOCAL_MACHINE主键中注册的键名。至于RegestName,RegestPassword就是保存合法的用户名及密码的了。



例子程序如下:

Option Explicit



Private Sub Form_Load()



Dim Temp As ClassRegest   ‘请先在”引用”中引用这个类(动态链接库)



Set Temp = New ClassRegest



Temp.RegestKey = "Software\RegestTest"   ‘设置你的软件在注册表中注册的键名

Temp.Regestcheck   ‘判断是否注册, 判断结果保存在Regested属性中

‘必须先赋值RegestKey及执行一遍RegestCheck,其它的属性及方法才能被正确执行



MsgBox "Regeted is " & Temp.Regested



Temp.GetNamePassword ’通过一定的算法为RegestName,RegestPassword赋于一个合法的值

MsgBox "name is: " & Temp.RegestName

MsgBox "password is: " & Temp.RegestPassword



Temp.Regest  ‘如果共享软件没有注册,则注册这个软件



Set Temp=Nothing



End Sub



现在把这个DLL动态链接库的源代码提供如下:

(VB6.0测试通过)



Option Explicit



Private Const HKEY_LOCAL_MACHINE  As Long = &H80000002 注释:注册表函数的几个参数

Private Const KEY_QUERY_VALUE  As Long = &H1

Private Const KEY_SET_VALUE  As Long = &H2

Private Const REG_SZ  As Long = 1



Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long



Private m_Regested As Boolean 注释:是否注册属性

Private m_RegestKey As String 注释:注册表中的子键名

Private m_Name As String      注释:用户名属性

Private m_Password As String  注释:密码属性



Private nCount As Integer     注释:用来临时计数

Private lReturn As Long       注释:接收返回值

Private Const sTarget As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ,.;:" 注释:用来生成随机文本

Private FSO As FileSystemObject  注释:用来产生随机文件的文件系统对象

Private FSOFile As File

Private FSOString As TextStream



Private Sub Class_Initialize()



m_Regested = False

m_RegestKey = ""



End Sub



Public Sub RegestCheck()



Dim sName As String * 9      注释:保存注册表中读出的用户名

Dim sPassword As String * 26 注释:保存注册表中读出的密码

Dim hEditKey As Long         注释:保存打开的注册表键的句柄

Dim lRegOpenError As Long    注释:保存打开注册表某主键的返回值



lRegOpenError = RegOpenKeyEx(HKEY_LOCAL_MACHINE, m_RegestKey, 0, KEY_QUERY_VALUE, hEditKey)



If lRegOpenError <> 0 Then   注释:如果打开出错

  MsgBox "Open Reg Error!Terminate!Please examine RegestKey."

  Exit Sub

End If



lReturn = RegQueryValueEx(hEditKey, "Name", 0, REG_SZ, sName, 9)

If lReturn = 2 Then          注释:如果Name键值不存在

  GoTo FORNEXT

End If

lReturn = RegQueryValueEx(hEditKey, "Password", 0, REG_SZ, sPassword, 26)

If lReturn = 2 Then

  GoTo FORNEXT

End If



If KeyCheck(Left(sName, 8), Left(sPassword, 25)) = True Then

  m_Regested = True   注释:KeyCheck检查Name和Password是否为合法,合法则m_regested被设为True

  Exit Sub

End If



FORNEXT:

m_Regested = False   注释:未通过KeyCheck则m_Regested设为否



Randomize            注释:初始化随机数生成器



Dim hFileNumber As Integer          注释:打开当前目录下的Key.dat文件,该文件用来保存用以生成Name及Password的一个随机字符串

hFileNumber = FreeFile

If Right(App.Path, 1) = "\" Then

  Open App.Path & "Key.dat" For Binary As hFileNumber

Else

  Open App.Path & "\Key.dat" For Binary As hFileNumber

End If



Dim iRandom As Integer                   注释:生成随机字符数组baRandom()

Dim baRandom(1 To 100) As Byte

Dim iTemp As Integer

Dim iNameLength As Integer

Dim iPasswordLength As Integer

Dim iKeyLength As Integer

iNameLength = 0

iPasswordLength = 0

For nCount = 1 To 100 Step 3

  If iNameLength = 8 Then

   baRandom(nCount) = &HFF

   nCount = nCount + 1

   iNameLength = 9

  End If

  baRandom(nCount) = CByte(CStr(Int(32 * Rnd)))

  iTemp = (CInt(baRandom(nCount)) + 1) ^ 2 - CInt(baRandom(nCount)) ^ 2

  baRandom(nCount + 1) = CByte(CInt(iTemp * Rnd))

  If iNameLength < 8 Then

   baRandom(nCount + 2) = CByte(Int((8 - iNameLength) * Rnd) + 1)

   iNameLength = iNameLength + CInt(baRandom(nCount + 2))

  Else

   If iPasswordLength < 25 Then

    baRandom(nCount + 2) = CByte(Int((25 - iPasswordLength) * Rnd + 1))

    iPasswordLength = iPasswordLength + CInt(baRandom(nCount + 2))

   Else

    iKeyLength = nCount - 1

    nCount = 100

   End If

  End If

Next

   

For nCount = 1 To iKeyLength            注释:在Key.dat中写入baRandom()

  Put #hFileNumber, nCount, baRandom(nCount)

Next



Close #hFileNumber



Set FSO = CreateObject("Scripting.FileSystemObject")  注释:生成一个1024字节的随机字符组成的ASIIC文件

If Right(App.Path, 1) = "\" Then

  If FSO.FileExists(App.Path & "Value.dat") Then

   Set FSOFile = FSO.GetFile(App.Path & "Value.dat")

   Set FSOString = FSOFile.OpenAsTextStream(ForWriting, TristateFalse)

  Else

   Set FSOString = FSO.CreateTextFile(App.Path & "Value.dat", True, False)

  End If

Else

  If FSO.FileExists(App.Path & "\Value.dat") Then

   Set FSOFile = FSO.GetFile(App.Path & "\Value.dat")

   Set FSOString = FSOFile.OpenAsTextStream(ForWriting, TristateFalse)

  Else

   Set FSOString = FSO.CreateTextFile(App.Path & "\Value.dat", True, False)

  End If

End If

For nCount = 1 To 1024

  FSOString.Write (Mid(sTarget, Int(56 * Rnd + 1), 1))

Next



lReturn = RegCloseKey(hEditKey)



Erase baRandom



Set FSO = Nothing

Set FSOFile = Nothing

Set FSOString = Nothing

Close #hFileNumber



End Sub





Private Function KeyCheck(ForCheckName As String, ForCheckPassword As String) As Boolean

注释:接收两个从注册表中读出的字符串Name和Password



注释:如果注册表中没有Name和Password键值则此二值为空,以下检测该字符串第一个字符是否在sTarget中

If InStr(1, sTarget, Left(ForCheckName, 1), vbTextCompare) = 0 Or InStr(1, sTarget, Left(ForCheckPassword, 1), vbTextCompare) = 0 Then

  KeyCheck = False

  Exit Function

End If



注释:调用CalculateNamePassword,返回合法的Name及Password

注释:返回值的形式为Name%Password

  

Dim sTotal As String

sTotal = CalculateNamePassword

Dim sCalName As String

Dim sCalPassword As String

sCalName = Left(sTotal, 8)

sCalPassword = Right(sTotal, 25)



注释:检测是否符合

For nCount = 1 To 8

  If Mid(ForCheckName, nCount, 1) <> Mid(sCalName, nCount, 1) Then

   KeyCheck = False

   Exit Function

  End If

Next



For nCount = 1 To 25

  If Mid(ForCheckPassword, nCount, 1) <> Mid(sCalPassword, nCount, 1) Then

   KeyCheck = False

   Exit Function

  End If

Next



KeyCheck = True



End Function



Public Property Get Regested() As Variant                  注释:是否注册的只读属性

Regested = m_Regested

End Property



Public Property Get RegestKey() As String                  注释:客户应用程序在注册表中的注册键

RegestKey = m_RegestKey

End Property



Public Property Let RegestKey(ByVal vNewValue As String)

m_RegestKey = vNewValue

End Property



Private Function CalculateNamePassword() As String         注释:用来以Name%Password格式返回

                                                           注释:合法用户名及密码的私有方法

注释:如果Value.dat不存在,则立即退出

Set FSO = CreateObject("Scripting.FileSystemObject")

If Right(App.Path, 1) = "\" Then

  If FSO.FileExists(App.Path & "Value.dat") = False Then

   CalculateNamePassword = ""

   Set FSO = Nothing

   Exit Function

  End If

Else

  If FSO.FileExists(App.Path & "\Value.dat") = False Then

   CalculateNamePassword = ""

   Set FSO = Nothing

   Exit Function

  End If

End If



Dim sCalculateName As String        注释:合法的用户名

Dim sCalculatePassword As String    注释:合法的密码

sCalculateName = ""

sCalculatePassword = ""



Dim hFileNumberKey As Integer       注释:打开两个文件Key.dat和Value.dat

hFileNumberKey = FreeFile

If Right(App.Path, 1) = "\" Then

  Open App.Path & "Key.dat" For Binary As hFileNumberKey

Else

  Open App.Path & "\Key.dat" For Binary As hFileNumberKey

End If

Dim hFileNumberValue As Integer

hFileNumberValue = FreeFile

If Right(App.Path, 1) = "\" Then

  Open App.Path & "Value.dat" For Binary As hFileNumberValue

Else

  Open App.Path & "\Value.dat" For Binary As hFileNumberValue

End If



Dim bFirst As Byte

Dim bSecond As Byte

Dim bLength As Byte

Dim bFF As Byte

Dim bCode As Byte

Dim iPasswordStart As Integer

Dim iLength As Integer

For nCount = 1 To 24 Step 3

  Get #hFileNumberKey, nCount, bFF

  If bFF <> &HFF Then

   Get #hFileNumberKey, nCount, bFirst

   Get #hFileNumberKey, nCount + 1, bSecond

   Get #hFileNumberKey, nCount + 2, bLength

   For iLength = 1 To CInt(bLength)

    Get #hFileNumberValue, CInt(bFirst) ^ 2 + CInt(bSecond) + iLength - 1, bCode

    sCalculateName = sCalculateName & Chr(bCode)

   Next

  Else

   iPasswordStart = nCount

   Exit For

  End If

Next

For nCount = iPasswordStart + 1 To 100 Step 3

  Get #hFileNumberKey, nCount, bFirst

  Get #hFileNumberKey, nCount + 1, bSecond

  Get #hFileNumberKey, nCount + 2, bLength

  For iLength = 1 To CInt(bLength)

   Get #hFileNumberValue, CInt(bFirst) ^ 2 + CInt(bSecond) + iLength - 1, bCode

   sCalculatePassword = sCalculatePassword & Chr(bCode)

   If Len(sCalculatePassword) = 25 Then

    nCount = 100

    Exit For

   End If

  Next

Next



CalculateNamePassword = sCalculateName & "%" & sCalculatePassword



Set FSO = Nothing

Close #hFileNumberKey

Close #hFileNumberValue



End Function



Public Property Get RegestName() As String         注释:只读用户名属性

RegestName = m_Name

End Property



Public Property Get RegestPassword() As String     注释:只读密码属性

RegestPassword = m_Password

End Property



Public Sub GetNamePassword()                       注释:获得用户名及密码的公用方法

                                                   注释:调用一次就会给用户名属性和密码属性赋一合法值

Dim sTotal As String



sTotal = CalculateNamePassword

m_Name = Left(sTotal, 8)

m_Password = Right(sTotal, 25)



End Sub



Public Sub Regest()                                注释:以合法用户名及密码注册软件的公有方法



Dim sTotal As String

Dim sSubName As String

Dim sSubPassword As String

Dim hEditKey As Long



sTotal = CalculateNamePassword

sSubName = Left(sTotal, 8)

sSubPassword = Right(sTotal, 25)



Dim lRegOpenError As Long



lRegOpenError = RegOpenKeyEx(HKEY_LOCAL_MACHINE, m_RegestKey, 0, KEY_SET_VALUE, hEditKey)



If lRegOpenError <> 0 Then

  MsgBox "Open Reg Error!Terminate!Please examine RegestKey."

  Exit Sub

End If

  

Dim lReturn As Long

lReturn = RegSetValueEx(hEditKey, "Name", 0, REG_SZ, sSubName, 8)

lReturn = RegSetValueEx(hEditKey, "Password", 0, REG_SZ, sSubPassword, 25)



End Sub