请高手分析我的软件“注册及试用期控制程序段”是否有隐含BUG

[mi6236]

1.?如何才能找到系统路径未解决
Option Explicit
Sub main()
Dim ws As Workspace
Dim db As Database
Dim tdf As TableDef
Dim fld As Field
Dim rst As Recordset
If Dir("c:\windows\system\register.mdb") = "" Then
Set ws = DBEngine.Workspaces(0)
Set db = ws.CreateDatabase("c:\windows\system\register.mdb", dbLangGeneral)
db.Connect = ";pwd=andy"
Set tdf = db.CreateTableDef("register")
Set fld = tdf.CreateField("register", 2)
tdf.Fields.Append fld
db.TableDefs.Append tdf
Set db = ws.OpenDatabase("c:\windows\system\register.mdb")
Set rst = db.OpenRecordset("register")
rst.AddNew
rst.Fields("register") = 0
rst.Update
rst.Close
register.Show
Else
Dim str_pwd As String
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase("c:\windows\system\register.mdb", str_pwd = "springlover")
Set rst = db.OpenRecordset("register")
rst.MoveFirst
If rst.Fields("register") = 1 Then
MDIForm1.Show
Else
register.Show
End If
End If
End Sub

[mi6236]

Option Explicit
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 Sub cancel_Click()
' On Error GoTo error
'系统检测是否有date.mdb文件，如果没有，则是系统第一次安装，建立此数据库文件
If Dir("c:\windows\system\date.mdb") = "" Then
Dim ws As Workspace
Dim db As Database
Dim tdf As TableDef
Dim fld As Field
Dim idx As Index
Dim rst As Recordset
Dim str_pwd As String
'DBEngine对象相当于Jet数据库引擎，不需要创建该对象,CreateWorkspace创建一个工作区对象
'Workspace对象为用户定义一个会话，通过与之关联的用户名和口令建立一个安全级别。当不需要安全级别时可使用缺省的工作区DBEngine.Workspace(0)
Set ws = DBEngine.Workspaces(0)
'创建一个空的数据库文件，dbLangGeneral参数用来确定数据驱动程序支持的参数
Set db = ws.CreateDatabase("c:\windows\system\date.mdb", dbLangGeneral)
'指定打开的数据库类型，并且包括参数，如用户和口令
db.Connect = ";pwd=andy"
'创建一张新表
Set tdf = db.CreateTableDef("date")
tdf.Attributes = 0
tdf.Connect = ""
tdf.SourceTableName = ""
tdf.ValidationRule = ""
tdf.ValidationText = "" 'field first_time
'创建first_time字段
Set fld = tdf.CreateField("first_time", dbDate, 8)
fld.Attributes = 1
fld.DefaultValue = ""
fld.OrdinalPosition = 0
fld.Required = False
fld.ValidationRule = ""
fld.ValidationText = ""
tdf.Fields.Append fld '把first_time字段添加到表中
Set fld = tdf.CreateField("last_time", dbDate, 8) '创建last_time字段
fld.Attributes = 1
fld.Required = False
fld.ValidationRule = ""
fld.ValidationText = ""
tdf.Fields.Append fld '把last_time字段添加到表中
Set fld = tdf.CreateField("times", dbInteger, 2) '创建times字段
fld.Attributes = 1
fld.DefaultValue = ""
fld.OrdinalPosition = 2
fld.Required = False
fld.ValidationRule = ""
fld.ValidationText = ""
tdf.Fields.Append fld '把times字段添加到表中
db.TableDefs.Append tdf '将date表添加到date.mdb中
db.Close '关闭data.mdb
Set db = ws.OpenDatabase("c:\windows\system\date.mdb") '以可读写方式打开date.mdb
Set rst = db.OpenRecordset("date") '打开一个记录集
With rst
.AddNew '向记录集增加一条新记录
'写入一条记录
.Fields("first_time") = Date
.Fields("last_time") = Date
.Fields("times") = 1
.Update '将记录写入数据库
End With
db.Close '关闭date.mdb
MsgBox "这是你第一次启动本系统!你的试用期为30天，今天是第一天，谢谢使用!", 48, "金鹏软件工作室"
MDIForm1.Show '启动你和主窗体
Else '系统有date.mdb文件，则不是第一次运行，就不用建立数据库文件了.
Dim ws2 As Workspace
Dim db2 As Database
Dim rst2 As Recordset
Dim num As Integer
Set ws2 = Workspaces(0)
Set db2 = ws2.OpenDatabase("c:\windows\system\date.mdb", str_pwd = "springlover")
Set rst2 = db2.OpenRecordset("date") '开始检测用户是否修改了系统日期
rst2.MoveFirst
If rst2.Fields("last_time") > Date Then
MsgBox "对不起，你在本软件的试用期骨不可以修改系统日期，否则将取消你地不系统的试用权，如果你想继续使用本软件。请你恢复系统日期，谢谢合作!", 48, "金鹏软件工作室"
End
End If
If Date - rst2.Fields("first_time") >= 30 Then '设定试用期为30天
MsgBox "你已经启动本系统" & rst2.Fields("times") & "而且已经到了30天的试用期如果你想继续使用本软件，请你到本公司注册并购买正版的软件!", 48, "金鹏软件工作室"
Else
'仍在试用期内
num = rst2.Fields("times")
rst2.Edit
rst2.Fields("last_time") = Date
rst2.Fields("times") = num + 1
rst2.Update
MsgBox "这是你第" & rst2.Fields("times") & "次使用本系统，你还有" & 30 - (Date - rst2.Fields("first_time")) & "天的试用期，祝你今天工件愉快！", 48, "金鹏软件工作室"
MDIForm1.Show '启动你的主窗体
End If
End If
Unload register '关闭注册窗口
Exit Sub

'error:
' MsgBox Err.Description
End Sub

Private Sub enter_Click()
'验证注册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, 127, volNumber, MCM, FSF, Fsys, 127)
Dim Tid As Long
Dim regid As Long
Tid = volNumber / 2 + 123456789
regid = Val(Trim(Text2.Text))
If regid = Tid / 4 * 3 + 987654321 Then
MsgBox "恭喜您已经注册成功，欢迎使用水利造价管理系统", vbOKOnly, "金鹏软件工作室"
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase("c:\windows\system\register.mdb")
Set rst = db.OpenRecordset("register")
rst.MoveFirst
rst.Edit
rst.Fields("register") = 1
rst.Update
db.Close
Unload register
MDIForm1.Show
Else
MsgBox "注册码错误，请重新输入！"
Exit Sub
End If
End Sub

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, 127, volNumber, MCM, FSF, Fsys, 127)
'volNumber是C盘序列号
localid = volNumber / 2 + 123456789
Text1.Text = localid
End Sub

[mi6236]

Private Sub extract_Click()
'根据原ID算出注册ID
Dim regid As Long
If IsNumeric(Text1.Text) Then
regid = CLng(Text1.Text) / 4 * 3 + 987654321
Else
'error
End If
Text2.Text = regid
End Sub

[mi6236]

ding

[dofly]

個人意見,謹供參考!

寫一個 ini文件來記錄或者寫在注冊表里面.

[My97]

答如何找到系统路径:

'获取system目录的声明
Private Declare Function GetSystemDirectory Lib "KERNEL32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long


'在代码中调用就可以了
Call GetSystemDirectory(SystemDirectory, 255)

返回字符串变量 SystemDirectory

[mi6236]

如何找到系统路径已于今日上午实现，感谢 My97(冷空气) 的热情回答，希望能帮我分析一下程序的安全性有没有问题