📄 reg.frm
字号:
VERSION 5.00
Object = "{90F3D7B3-92E7-44BA-B444-6A8E2A3BC375}#1.0#0"; "ACTSKIN4.OCX"
Object = "{F27AA50A-8600-11D1-AD8F-DB21EA843472}#6.1#0"; "EnCrypt2.ocx"
Begin VB.Form REG
BorderStyle = 3 'Fixed Dialog
Caption = "软件未注册（15次试用）"
ClientHeight = 2205
ClientLeft = 45
ClientTop = 330
ClientWidth = 5415
Icon = "REG.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2205
ScaleWidth = 5415
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command3
Caption = "如何注册"
Height = 465
Left = 4140
TabIndex = 7
Top = 1650
Width = 1125
End
Begin VB.TextBox Text1
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 285
Left = 1560
TabIndex = 4
Top = 120
Width = 2325
End
Begin VB.Frame Frame1
Caption = "请输入授权码:"
Height = 915
Left = 180
TabIndex = 2
Top = 570
Width = 3795
Begin VB.TextBox Text2
Alignment = 2 'Center
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 345
IMEMode = 3 'DISABLE
Left = 180
TabIndex = 3
Top = 330
Width = 3315
End
End
Begin VB.CommandButton Command1
Caption = "注册验证"
Height = 495
Left = 4140
TabIndex = 1
Top = 990
Width = 1125
End
Begin VB.CommandButton Command2
Caption = "软件试用"
Height = 465
Left = 4140
TabIndex = 0
Top = 300
Width = 1125
End
Begin ACTIVESKINLibCtl.Skin Skin1
Left = 810
OleObjectBlob = "REG.frx":1D42
Top = 30
End
Begin DevPowerEncrypt.EnCrypt EnCrypt1
Left = 30
Top = 90
_ExtentX = 847
_ExtentY = 847
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 225
Index = 0
Left = 240
OleObjectBlob = "REG.frx":5497B
TabIndex = 5
Top = 150
Width = 1155
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 645
Index = 4
Left = 90
OleObjectBlob = "REG.frx":549DC
TabIndex = 6
Top = 1560
Width = 3915
End
End
Attribute VB_Name = "REG"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim rs As Recordset
Dim STR As String
Dim renhb As String
Public PassText As String
Private Sub Command1_Click()
On Error Resume Next
If Text2.Text = Mid$(EnCrypt1.EnCrypt(Crypt(StrReverse(Mid$(Text1, 2)), "nhb089")), 5) Then
Dim FILENO
FILENO = FreeFile()
Open App.Path & "\REG3.dll" For Output As #FILENO
Print #FILENO, Text2
Close #FILENO
'注册成功写入REG.DLL文件中
' SetKeyValue HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN", "8", 1, REG_SZ
' '在注册表中记录次数
'
' Set db = OpenDatabase(App.Path & "\SET.PAS")
' db.Execute "UPDATE 格式 SET 常规=1"
' db.Close
' Set db = Nothing
Text2.Text = "请保管好此授权码"
MsgBox "注册成功!请重新启动程序", 32, "感谢您的支持"
Else
Unload Me
End If
End Sub
Private Sub Command2_Click()
On Error Resume Next
Unload Me
MAIN.Show
End Sub
Private Sub Command3_Click()
ABOUT.Show 1, REG
End Sub
Private Sub Form_Load()
On Error Resume Next
Set db = OpenDatabase(App.Path & "\SET.PAS")
Set rs = db.OpenRecordset("SELECT 常规 FROM 格式")
XXX = rs![常规]
If QueryValue(HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN", "8") = "" And XXX = 1 Then
CreateNewKey HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN"
SetKeyValue HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN", "8", 1, REG_SZ
MsgBox "数据库初始化成功!请重新启动!", 64, "程序首次使用"
Unload Me
Else
Text1.Text = GetSerialNumber("c:\")
' Skin1.LoadSkin App.Path & "\SKIN\7.sk"
Skin1.ApplySkin Me.hwnd
Me.Hide
If Exists(App.Path & "\REG3.dll") Then
Open App.Path & "\REG3.dll" For Input As #1
renhb = StrConv(InputB$(LOF(1), 1), vbUnicode)
Close #1
If renhb = Mid$(EnCrypt1.EnCrypt(Crypt(StrReverse(Mid$(Text1, 2)), "nhb089")), 5) + Chr(13) + Chr(10) Then
Unload Me
MAIN.Show
Else
Me.Show
'调出数据库中的记录次数
If XXX >= 20 Then Command2.Enabled = False: Me.Caption = "软件试用期已到"
If XXX <= 0 Then Command2.Enabled = False: Me.Caption = "软件试用期已到"
If Val(QueryValue(HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN", "8")) >= 20 Then Command2.Enabled = False: Me.Caption = "软件试用期已到"
If Val(QueryValue(HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN", "8")) <= 0 Then Command2.Enabled = False: Me.Caption = "软件试用期已到"
'如果数据库记录次数大于等设置值时,则不可再试用
If Val(QueryValue(HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN", "8")) <> XXX Then
Command2.Enabled = False: Me.Caption = "软件试用期已到"
Else
Set db = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\SET.PAS")
db.Execute "UPDATE 格式 SET 常规=1+ 常规"
db.Close
'在数据库记录次数
CreateNewKey HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN"
SetKeyValue HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN", "8", XXX + 1, REG_SZ
'在注册表中记录次数
End If
End If
Else
Me.Show
' MsgBox "File not found"
Set db = OpenDatabase(App.Path & "\SET.PAS")
Set rs = db.OpenRecordset("SELECT 常规 FROM 格式")
XXX = rs![常规]
'调出数据库中的记录次数
If XXX >= 20 Then Command2.Enabled = False: Me.Caption = "软件试用期已到"
If XXX <= 0 Then Command2.Enabled = False: Me.Caption = "软件试用期已到"
If Val(QueryValue(HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN", "8")) >= 20 Then Command2.Enabled = False: Me.Caption = "软件试用期已到"
If Val(QueryValue(HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN", "8")) <= 0 Then Command2.Enabled = False: Me.Caption = "软件试用期已到"
'如果数据库记录次数大于等设置值时,则不可再试用
If Val(QueryValue(HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN", "8")) <> XXX Then
Command2.Enabled = False: Me.Caption = "软件试用期已到"
Else
Set db = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\SET.PAS")
db.Execute "UPDATE 格式 SET 常规=1+ 常规"
db.Close
'在数据库记录次数
CreateNewKey HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN"
SetKeyValue HKEY_CLASSES_ROOT, "zip3\heroboy\FILE\OPEN", "8", XXX + 1, REG_SZ
'在注册表中记录次数
End If
End If
End If
End Sub
'If Text4.Text = Mid$(EnCrypt1.EnCrypt(Crypt(StrReverse(Mid$(Text3, 2)), "nhb089")), 5) Then
'
'MsgBox "YES"
'
'End If
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
'下面的代码可以关闭所有打开的 DAO workspace，并释放所占的内存。
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Dim ws As Workspace
Dim db As Database
Dim rs As Recordset
For Each ws In Workspaces
For Each db In ws.Databases
For Each rs In db.Recordsets
rs.Close
Set rs = Nothing
Next
db.Close
Set db = Nothing
Next
ws.Close
Set ws = Nothing
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -