📄 frmreg.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 FRMreg
BorderStyle = 3 'Fixed Dialog
Caption = "软件未注册(15次试用)"
ClientHeight = 3690
ClientLeft = 45
ClientTop = 435
ClientWidth = 5445
Icon = "FRMreg.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3690
ScaleWidth = 5445
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command3
Caption = "如何注册"
Height = 495
Left = 4050
TabIndex = 9
Top = 3090
Width = 1275
End
Begin VB.Frame Frame3
Caption = "注册信息"
Height = 1215
Left = 120
TabIndex = 4
Top = 660
Width = 5205
Begin VB.TextBox Text1
Alignment = 2 'Center
Enabled = 0 'False
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 = 1290
Locked = -1 'True
TabIndex = 6
Top = 720
Width = 3765
End
Begin VB.TextBox Text3
Alignment = 2 'Center
ForeColor = &H00FF0000&
Height = 285
Left = 1290
TabIndex = 5
Text = "注意：注册时请此处输入您的真实校名全称"
Top = 300
Width = 3765
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 225
Index = 0
Left = 120
OleObjectBlob = "FRMreg.frx":1D42
TabIndex = 7
Top = 750
Width = 1155
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 225
Index = 2
Left = 120
OleObjectBlob = "FRMreg.frx":1DA3
TabIndex = 8
Top = 330
Width = 1155
End
End
Begin VB.CommandButton Command2
Caption = "软件试用"
Height = 495
Left = 180
TabIndex = 3
Top = 3090
Width = 1305
End
Begin VB.CommandButton Command1
Caption = "注册验证"
Height = 495
Left = 2580
TabIndex = 2
Top = 3090
Width = 1275
End
Begin VB.Frame Frame1
Caption = "请输入授权码:"
Height = 915
Left = 150
TabIndex = 1
Top = 2010
Width = 5175
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 = 0
Top = 330
Width = 4845
End
End
Begin ACTIVESKINLibCtl.Skin Skin1
Left = 1830
OleObjectBlob = "FRMreg.frx":1E04
Top = 3090
End
Begin DevPowerEncrypt.EnCrypt EnCrypt1
Left = 6330
Top = 5970
_ExtentX = 847
_ExtentY = 847
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4
Height = 465
Index = 4
Left = 150
OleObjectBlob = "FRMreg.frx":4C2F3
TabIndex = 10
Top = 120
Width = 5085
End
End
Attribute VB_Name = "FRMreg"
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)), "65831")), 5) Then
Dim FILENO
FILENO = FreeFile()
Open App.Path & "\REG.dll" For Output As #FILENO
Print #FILENO, Text2
Close #FILENO
'注册成功写入REG.DLL文件中
' SetKeyValue HKEY_CLASSES_ROOT, "zip\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 = "请保管好此授权码"
Dim success As Long
success = WritePrivateProfileString("学校", "校名", Text3.Text, App.Path & "\SET.ini")
MsgBox "注册成功!请重新启动程序", 32, "感谢您的支持"
MsgBox "请保存好此授权码与申请时的识别码", 32, "警告!!!切记!!!"
Command1.Enabled = False
Command3.Caption = "退 出"
Command2.Enabled = False
Skin1.ApplySkin Me.hwnd
Else
' Dim success As Long
success = WritePrivateProfileString("学校", "校名", "您使用的是未经授权的软件,请与作者联系:倪华兵 手机:13851318078", App.Path & "\SET.ini")
Unload Me
End If
End Sub
Private Sub Command2_Click()
Unload Me
MAIN.Show
End Sub
Private Sub Command3_Click()
On Error Resume Next
If Command3.Caption = "退 出" Then
Unload Me
End
Else
ABOUT2.Show
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim success As Long
Set db = OpenDatabase(App.Path & "\SET.PAS")
Set rs = db.OpenRecordset("SELECT 常规 FROM 格式")
XXX = rs![常规]
If QueryValue(HKEY_CLASSES_ROOT, "zip\heroboy\FILE\OPEN", "8") = "" And XXX = 1 Then
CreateNewKey HKEY_CLASSES_ROOT, "zip\heroboy\FILE\OPEN"
SetKeyValue HKEY_CLASSES_ROOT, "zip\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 & "\REG.dll") Then
Open App.Path & "\REG.dll" For Input As #1
renhb = StrConv(InputB$(LOF(1), 1), vbUnicode)
Close #1
If renhb = Mid$(EnCrypt1.EnCrypt(Crypt(StrReverse(Mid$(Text1, 2)), "65831")), 5) + Chr(13) + Chr(10) Then
Unload Me
MAIN.Show
Else
success = WritePrivateProfileString("学校", "校名", "您使用的是未经授权的软件,请与作者联系:倪华兵 手机:13851318078", App.Path & "\SET.ini")
Me.Show
'调出数据库中的记录次数
If XXX >= 20 Then Command2.Enabled = False: Command2.Visible = False: Me.Caption = "软件试用期已到"
If XXX <= 0 Then Command2.Enabled = False: Command2.Visible = False: Me.Caption = "软件试用期已到"
If Val(QueryValue(HKEY_CLASSES_ROOT, "zip\heroboy\FILE\OPEN", "8")) >= 20 Then Command2.Enabled = False: Command2.Visible = False: Me.Caption = "软件试用期已到"
If Val(QueryValue(HKEY_CLASSES_ROOT, "zip\heroboy\FILE\OPEN", "8")) <= 0 Then Command2.Enabled = False: Command2.Visible = False: Me.Caption = "软件试用期已到"
'如果数据库记录次数大于等设置值时,则不可再试用
If Val(QueryValue(HKEY_CLASSES_ROOT, "zip\heroboy\FILE\OPEN", "8")) <> XXX Then
Command2.Enabled = False: Command2.Visible = False: Me.Caption = "软件试用期已到"
success = WritePrivateProfileString("学校", "校名", "您使用的是未经授权的软件,请与作者联系:倪华兵 手机:13851318078", App.Path & "\SET.ini")
Else
Set db = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\SET.PAS")
db.Execute "UPDATE 格式 SET 常规=1+ 常规"
db.Close
'在数据库记录次数
CreateNewKey HKEY_CLASSES_ROOT, "zip\heroboy\FILE\OPEN"
SetKeyValue HKEY_CLASSES_ROOT, "zip\heroboy\FILE\OPEN", "8", XXX + 1, REG_SZ
success = WritePrivateProfileString("学校", "校名", "您使用的是未经授权的软件,请与作者联系:倪华兵 手机:13851318078", App.Path & "\SET.ini")
'在注册表中记录次数
End If
End If
Else
Me.Show
success = WritePrivateProfileString("学校", "校名", "您使用的是未经授权的软件,请与作者联系:倪华兵 手机:13851318078", App.Path & "\SET.ini")
' 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: Command2.Visible = False: Me.Caption = "软件试用期已到"
If XXX <= 0 Then Command2.Enabled = False: Command2.Visible = False: Me.Caption = "软件试用期已到"
If Val(QueryValue(HKEY_CLASSES_ROOT, "zip\heroboy\FILE\OPEN", "8")) >= 20 Then Command2.Enabled = False: Command2.Visible = False: Me.Caption = "软件试用期已到"
If Val(QueryValue(HKEY_CLASSES_ROOT, "zip\heroboy\FILE\OPEN", "8")) <= 0 Then Command2.Enabled = False: Command2.Visible = False: Me.Caption = "软件试用期已到"
'如果数据库记录次数大于等设置值时,则不可再试用
If Val(QueryValue(HKEY_CLASSES_ROOT, "zip\heroboy\FILE\OPEN", "8")) <> XXX Then
Command2.Enabled = False: Command2.Visible = False: Me.Caption = "软件试用期已到"
success = WritePrivateProfileString("学校", "校名", "您使用的是未经授权的软件,请与作者联系:倪华兵 手机:13851318078", App.Path & "\SET.ini")
Else
Set db = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\SET.PAS")
db.Execute "UPDATE 格式 SET 常规=1+ 常规"
db.Close
'在数据库记录次数
CreateNewKey HKEY_CLASSES_ROOT, "zip\heroboy\FILE\OPEN"
SetKeyValue HKEY_CLASSES_ROOT, "zip\heroboy\FILE\OPEN", "8", XXX + 1, REG_SZ
success = WritePrivateProfileString("学校", "校名", "您使用的是未经授权的软件,请与作者联系:倪华兵 手机:13851318078", App.Path & "\SET.ini")
'在注册表中记录次数
End If
End If
End If
End Sub
'If Text4.Text = Mid$(EnCrypt1.EnCrypt(Crypt(StrReverse(Mid$(Text3, 2)), "65831")), 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 + -