知识大全 开发手记:共享软件注册程序编写实例(2)
Posted 时间
篇首语：知识的价值不在于占有，而在于使用。本文由小常识网(cha138.com)小编为大家整理，主要介绍了知识大全 开发手记:共享软件注册程序编写实例(2)相关的知识，希望对你有一定的参考价值。
Option Explicit Private Declare Function GetVolumeInformation Lib kernel _ 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 等到某一磁盘分区的信息 ＊＊＊＊＊＊＊＊＊＊＊＊注册窗体＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊ 运用另一个*** mdb来控制软件是否超出试用期 Private Sub Form_Load() 根据C盘序列号得到原ID Dim Driver VolName Fsys As String Dim volNumber MCM FSF As Long Driver = c:\\ Dim res As Long Dim localid As Long res = GetVolumeInformation(Driver VolName volNumber MCM FSF Fsys ) 将c盘序列号加密并显示在注册窗体的本机码中 localid = ＊＊＊＊＊volNumber＊＊＊＊＊ 加密算法 Text Text = localid 显示经加密后的本机码 End Sub Private Sub cancel_Click() On Error GoTo error 检测系统文件夹是否有*** mdb文件 如果没有 则是系统第一次安装 建立此数据库文件 If Dir(sPath & \\*** ** ) = Then Dim ws As Workspace Dim db As Database Dim tdf As TableDef Dim fld As Field Dim rst As Recordset DBEngine对象相当于Jet数据库引擎 不需要创建该对象 CreateWorkspace创建一个工作区对象 Workspace对象为用户定义一个会话 通过与之关联的用户名和口令建立一个安全级别 当不需要安全级别时可使用缺省的工作区DBEngine Workspace( ) Set ws = DBEngine Workspaces( ) 创建一个空的数据库文件 dbLangGeneral参数用来确定数据驱动程序支持的参数 Set db = ws CreateDatabase(sPath & \\*** mdb dbLangGeneral) 创建一张新表 Set tdf = db CreateTableDef( *** ) 创建first_time字段 Set fld = tdf CreateField( first_time dbDate ) tdf Fields Append fld 把first_time字段添加到表中 创建last_time字段 Set fld = tdf CreateField( last_time dbDate ) tdf Fields Append fld 把last_time字段添加到表中 创建times字段 Set fld = tdf CreateField( times dbInteger ) tdf Fields Append fld 把times字段添加到表中 db TableDefs Append tdf 将***表添加到*** mdb中 db Close 关闭*** mdb Set db = ws OpenDatabase(sPath & \\*** mdb ) 以可读写方式打开*** mdb Set rst = db OpenRecordset( *** ) 打开一个记录集 With rst AddNew 向记录集增加一条新记录 写入一条记录 Fields( first_time ) = Date Fields( last_time ) = Date Fields( times ) = Update 将记录写入数据库 End With rst Close db Close 关闭*** mdb ws Close **********更改系统时间 来实现隐藏注册库的修改时间*************** ……………………………………… ………………………………………… ………………………………………………… dbEncrypt dbEncrypt (sPath & \\*** mdb ) 数据库加密 Name sPath & \\*** mdb As sPath & \\*** ** ********************将时间改会原来时间************************ ………………………… ………………………… MsgBox 这是你首次启动本系统!你的试用期为 天 今天是第一天 谢谢使用! vbOKOnly + vbInformation 欢迎! *** Show 启动主窗体 Else 系统有*** mdb文件 则不是第一次运行 就不用建立数据库文件了 Dim ws As Workspace Dim db As Database Dim rst As Recordset Dim num As Integer dbEncrypt dbExplain (sPath & \\*** ** ) Set ws = Workspaces( ) Set db = ws OpenDatabase(sPath & \\*** ** ) Set rst = db OpenRecordset( *** ) 开始检测用户是否修改了系统日期 rst MoveFirst If rst Fields( last_time ) > Date Or rst Fields( times ) > Then MsgBox 对不起 你在本软件的试用期不可以修改系统日期 否则将取消您的系统试用权 如果你想继续使用本软件 请您恢复系统日期 谢谢合作! vbOKOnly + vbInformation 提示 End End If If Date rst Fields( first_time ) >= Then 设定试用期为 天 MsgBox vbCrLf & 你已经启动本系统 & rst Fields( times ) & 次 但已超过了软件 天的试用期 & vbCrLf & vbCrLf & 如果您愿意继续使用本系统 请将 本机码 以打电话(*** ********) & vbCrLf & vbCrLf & 或发邮件()的形式与***联系来得到注册码! vbOKOnly + vbInformation 提示 Else 仍在试用期内 num = rst Fields( times ) rst Edit rst Fields( last_time ) = Date rst Fields( times ) = num + rst Update MsgBox 这是你第 & rst Fields( times ) & 次使用本系统 你还有 & (Date rst Fields( first_time )) & 天的试用期 祝你今天工件愉快！ vbOKOnly + vbInformation 提示 *** Show 启动你的主窗体 End If rst Close db Close ws Close ***************更改系统时间 来实现隐藏注册库的修改时间*************** …………………………………… ***************************************************************************** dbEncrypt dbEncrypt (sPath & \\*** mi ) 加密数据库 Name sPath & \\*** ** As sPath & \\*** ** 因在前面改动时间会影响库中的时间 故在这里做一下假改动来达到修改时间的目的 ********************将时间改会原来时间************************ ……………………………………… ************************************************************** End If Unload register 关闭注册窗口 Exit Sub error: dbEncrypt SaveError Register cancel_Click End Sub Private Sub enter_Click() On Error GoTo SaveErr: 进行注册 验证注册ID Dim ws As Workspace Dim db As Database Dim tdf As TableDef Dim rst As Recordset Dim fld As Field Dim Driver VolName Fsys As String Dim volNumber MCM FSF As Long Driver = c:\\ Dim res As Long res = GetVolumeInformation(Driver VolName volNumber MCM FSF Fsys ) 得到硬盘序列号 Dim Tid As Long Dim regid As String Tid = Val(Text Text) regid = Trim(Text Text) If regid = ******************* Then 判断输入的密码是否同解密算法得到的密码一致 ***********************更改系统时间 来实现隐藏注册库的修改时间*************** ……………………………… ***************************************************************************** MsgBox 恭喜您已经注册成功 欢迎使用水利工程投资控制与评审系统 vbOKOnly + vbInformation 提示 *****将注册信息写入密码注册库***** dbEncrypt dbExplain (sPath & \\*** ** ) 数据库解密 Set ws = DBEngine Workspaces( ) Set db = ws OpenDatabase(sPath & \\*** ** ) Set rst = db OpenRecordset( *** ) rst MoveFirst rst Edit rst Fields( *** ) = cha138/Article/program/net/201311/11710相关参考