小弟为共享软件作者制作的管理软件注册的动态链接库 (转)
小弟为共享软件作者制作的管理软件注册的动态链接库
XML:namespace prefix = o ns = "urn:schemas-microsoft-com:Office:office" />
作为共享软件作者,注册码被非法公布是件令你十分头疼的事情。小弟制作了这么一个类库。希望能有所帮助。它每次在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 = "SoftwareRegestTest" ‘设置你的软件在注册表中注册的键名
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
来自 “ ITPUB博客 ” ,链接:http://blog.itpub.net/10790690/viewspace-953078/,如需转载,请注明出处,否则将追究法律责任。
转载于:http://blog.itpub.net/10790690/viewspace-953078/
小弟为共享软件作者制作的管理软件注册的动态链接库 (转)相关推荐
- 教你制作一个简单的进销存管理软件,值得收藏!
首先要制作进销存软件,要具体了解进销存到底是什么含义,这三个字分别代表什么流程,在整个进销存管理中的组成.再根据不同的流程制作进销存软件相对应的部分-- 01进销存的定义 "进"- ...
- 体育开展教学测试的工具软件是什么,[索美体育软件]田径运动会编排软件 游泳比赛编排软件 跆拳道比赛编排管理软件 中学体育中考测试 秩序册制作 教学管理 场地管理 多媒体软件...
索美运动会管理软件部分功能演示 一般操作过程:先设置软件,然后1.电子报名 2.秩序册一键生成 3.打印比赛用表格 4.比赛成绩智能管理及报表打印 有任何问题我们可以通过QQ远程协助您,保证您的成功使 ...
- 最强大的电子书管理软件 calibre 资源
个人觉得,calibre是最强大的电子书管理软件,它提供电子书籍管理.元信息整理.格式转换.阅读设备书籍同步.新闻下载等功能.但calibre不是一个电子书下载软件,也不是电子书制作工具(而是 ...
- 参考文献管理软件Jabref和Zotero使用笔记
参考文献管理软件Jabref和Zotero使用笔记 1.摘要 2.关键词 3.前期准备 4. 重点来了,制作bib文献数据库. 5.另一个重点是在TeX源文件中使用生成的参考文献列表. 6. 编译 7 ...
- 基于(java)jsp收费管理软件的设计与实现
为了提高机房管理者的管理效率和减轻管理者的劳动强度,提高机房的利用率,发挥计算机的方便性和快捷性,提出了机房自由上机收费管理系统的设计方案. 机房自由上机收费系统是典型的数据库管理系统,其开发主要包括 ...
- 做企业网站设计制作用什么软件
我们从网络上常见到的企业网站是用什么软件制作? 网页设计从图片处理,Flash,数据库等完成,我们来看看网络上常用的软件有那些: 一.网站制作软件: 1.Microsoft FrontPage 如果你 ...
- Docker 镜像制作和管理
2 Docker 镜像制作和管理 2.1 Docker 镜像说明 2.1.1 Docker 镜像中有没有内核 docker run --rm apline uname -r #内核 2.1.2 为什么 ...
- 安装制作工具开源软件
Python打包工具 PyInstaller PyInstaller 是一个用来将 Python 程序打包成一个独立可执行软件包,支持 Windows.Linux 和 Mac OS X.更多PyIns ...
- [转]针对文献管理软件Note谈我心目中的个人资源信息管理软件
作者:sealogos Email:sealogos@gmail.com 个人主页:http://hexun.com/zyt0538 本文的起因与目的:随着自己大脑和电脑储存的资源越来越多 ...
最新文章
- 将tflearn的模型保存为pb,给TensorFlow使用
- 关于前端与微信交互账号绑定的问题
- 【高斯消元】兼 【期望dp】例题
- JS----JavaScript中的递归函数
- 【webGL入门2】点线面的绘制
- 前端学习(3174):react-hello-react之脚手架的配置
- nedc工况_东南DX3 EV续航升级 NEDC综合工况续航451公里
- 解决i9001WiFi频繁断线
- 安装vs2008出现的问题
- 你觉得人生最好的年龄段是哪段时间?
- 系统服务器属于无形资产,企业管理系统是否属于无形资产?
- mysql读写分离延迟_解决Mysql读写分离数据延迟
- LTspice蒙特卡罗分析正态分布图工具
- 中国176个AAAAA级景区,存起来吧!下一站你去哪里?
- PAYPAL使用虚拟卡的会有优势吗?
- 依行科技日常实习面经
- PPT和WORD转成PDF时图有黑底
- 华科计算机系统结构研究生就业,华中科技大学这四个“王牌”专业,堪比金字招牌,考上就是“香饽饽”...
- 计算机驱动安装的几个方法,不会安装驱动有福了,2个方法教你安装驱动程序,非常实用的知识...
- 导航栏不变,切换局部页面的方法