📄 main_zc.frm
字号:
VERSION 5.00
Begin VB.Form main_zc
Caption = "系统注册"
ClientHeight = 3960
ClientLeft = 60
ClientTop = 345
ClientWidth = 5490
LinkTopic = "Form1"
ScaleHeight = 3960
ScaleWidth = 5490
StartUpPosition = 1 '所有者中心
Begin VB.Frame Frame2
Caption = "软件注册"
Height = 1005
Left = 90
TabIndex = 7
Top = 2865
Width = 5310
Begin VB.CommandButton Command3
Caption = "退出"
Height = 300
Left = 4410
TabIndex = 13
Top = 540
Width = 780
End
Begin VB.CommandButton Command2
Caption = "注册"
Height = 300
Left = 3645
TabIndex = 12
Top = 540
Width = 780
End
Begin VB.CommandButton Command1
Caption = "§试用§"
Height = 300
Left = 3645
TabIndex = 11
Top = 255
Width = 1545
End
Begin VB.TextBox Text2
Height = 270
Left = 1635
TabIndex = 10
Top = 570
Width = 1890
End
Begin VB.TextBox Text1
Height = 270
Left = 1635
MaxLength = 10
TabIndex = 9
Text = "gcy"
Top = 240
Width = 1890
End
Begin VB.Image Image1
Height = 480
Left = 150
Picture = "main_zc.frx":0000
Stretch = -1 'True
Top = 360
Width = 570
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "用户名： 注册号："
Height = 645
Left = 885
TabIndex = 8
Top = 285
Width = 870
End
End
Begin VB.Frame Frame1
Height = 2775
Left = 90
TabIndex = 0
Top = 30
Width = 5310
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "这里"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 195
Left = 2640
TabIndex = 6
Top = 2475
Width = 525
End
Begin VB.Label Label5
Caption = $"main_zc.frx":1272
Height = 825
Left = 270
TabIndex = 5
Top = 1920
Width = 4845
End
Begin VB.Label Label4
Caption = " 汇款请寄：长春市二道区东盛大街89号亚泰广场C座2205室 吉林省明日科技有限公司 财务部（收） 邮编：130000"
Height = 375
Left = 270
TabIndex = 4
Top = 1455
Width = 4845
End
Begin VB.Label Label3
Caption = " 正式版只需交纳注册费1000元，进行注册后即可使用。"
Height = 375
Left = 270
TabIndex = 3
Top = 1170
Width = 4845
End
Begin VB.Label Label2
Caption = " 欢迎您使用图书综合管理系统适用版，如果您觉得方便实用，请购买正式版。"
Height = 375
Left = 270
TabIndex = 2
Top = 720
Width = 4845
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "用户您好："
Height = 285
Left = 150
TabIndex = 1
Top = 315
Width = 4845
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "2D2A11FA"
ForeColor = &H000000FF&
Height = 240
Left = -690
TabIndex = 14
Top = 2340
Visible = 0 'False
Width = 870
End
End
End
Attribute VB_Name = "main_zc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const REG_SZ = 1
Const REG_DWORD = 4
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias _
"GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias _
"RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, _
phkResult 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, lpData As Any, _
ByVal cbData As Long) As Long
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, lpData As Any, lpcbData As Long) As Long
Dim fso, txtfile
Dim mySerial As Long
Dim mylong As Long
Private Sub SNumber()
mystr = String$(255, Chr$(0))
mytype = String$(255, Chr$(0))
mylong = GetVolumeInformation("c:\", mystr, Len(mystr), mySerial, 0, 0, mytype, Len(mytype))
Set fso = CreateObject("Scripting.FileSystemObject")
Set txtfile = fso.CreateTextFile(App.Path & "\注册.txt", True)
txtfile.Write (mySerial)
txtfile.Close
End Sub
Private Sub Form_Load()
Call SNumber
Dim user1 As String
Dim reg1 As String
Dim ret1, ret2, lendata1, lendata2 As Long
ret1 = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\图书综合管理系统\user", 0, 0, hKey1)
ret2 = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\图书综合管理系统\reg", 0, 0, hKey2)
ret1 = RegQueryValueEx(hKey1, "用户名", 0, REG_SZ, ByVal vbNullString, lendata1)
ret2 = RegQueryValueEx(hKey2, "注册号", 0, REG_SZ, ByVal vbNullString, lendata2)
user1 = String(lendata1, Chr(0))
reg1 = String(lendata2, Chr(0))
RegQueryValueEx hKey1, "用户名", 0, REG_SZ, ByVal user1, lendata1
RegQueryValueEx hKey2, "注册号", 0, REG_SZ, ByVal reg1, lendata2
If Len(user1) > 1 And Len(reg1) > 1 Then
Load main_mm
main_mm.Show
Unload Me
End If
End Sub
Private Sub Label6_Click()
Call SNumber
End Sub
Private Sub Command1_Click()
Dim hKey As Long
Dim time1 As Long
Dim lendata As Long
Dim ret As Long
ret = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\图书综合管理系统\time", 0, 0, hKey)
ret = RegQueryValueEx(hKey, "使用次数", 0, REG_DWORD, 0, lendata)
RegQueryValueEx hKey, "使用次数", 0, REG_DWORD, time1, lendata
RegCreateKey HKEY_CURRENT_USER, "Software\图书综合管理系统\time", hKey
If time1 < 100 Then
RegSetValueEx hKey, "使用次数", 0, REG_DWORD, time1 + 1, 4
Load main_mm
main_mm.Show
Unload Me
Else
MsgBox "软件试用到期，请注册！"
End
End If
End Sub
Private Sub Command2_Click()
Call SNumber
If Text1.text = "" Then
MsgBox "系统不允许用户名为空！"
Exit Sub
End If
If Text2.text = Hex(Val(mySerial)) Then
MsgBox "注册成功！您的注册码为" & Text2.text
RegCreateKey HKEY_CURRENT_USER, "Software\图书综合管理系统\user", hKey1
RegCreateKey HKEY_CURRENT_USER, "Software\图书综合管理系统\reg", hKey2
RegSetValueEx hKey1, "用户名", 0, REG_SZ, ByVal Text1.text, 10
RegSetValueEx hKey2, "注册号", 0, REG_SZ, ByVal Text2.text, 20
Load main_mm
main_mm.Show
Unload Me
Else
MsgBox "注册号不正确，请重新注册！"
End If
End Sub
Private Sub Command3_Click()
End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -