applyfrm.frm
来自「guan yu pai ke xi tong de ruan jian」· FRM 代码 · 共 405 行 · 第 1/2 页
FRM
405 行
Begin VB.Image Image1
Height = 255
Left = 0
Top = 120
Width = 255
End
Begin VB.Label Label2
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2295
Index = 2
Left = 360
TabIndex = 12
Top = 480
Width = 5895
End
Begin VB.Label Label3
BorderStyle = 1 'Fixed Single
Caption = "Label3"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1320
TabIndex = 11
Top = 3000
Width = 5055
End
Begin VB.Label Label2
Caption = "注册码："
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 240
TabIndex = 9
Top = 3480
Width = 1215
End
Begin VB.Label Label2
Caption = "申请码："
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 240
TabIndex = 8
Top = 3000
Width = 1215
End
End
End
Attribute VB_Name = "Apply"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'此模块已经调试成功。
'此模块需要函数为：
'LogonOut
'SaveString
'GetString
Option Explicit
Private Sub Command1_Click(Index As Integer)
Dim FileName As String
Dim MyFile As Long '文件对象。
Dim FileSize As Long
Dim TemNum As Long
Dim myOfstruct As OFSTRUCT
On Error Resume Next
Select Case Index
Case 0:
If Frame1(0).Visible = True Then '判断是第一步还是第二步。
Frame1(0).Visible = False '关闭第一步的显示内容（协议）。
Frame1(1).Visible = True '显示第二步的提示和注册码输入框。
Command1(0).Caption = "注 册" '进入第二步后将“下一步”按钮改为“注 册”按钮。
Else
If UCase$(LogonOut(Label3.Caption)) = UCase$(Text2.Text) Then '判断输入的注册码是否正确。
'第一步，将注册信息写入文件。
FileName = App.Path & "\images\paike.ico"
MyFile = OpenFile(FileName, myOfstruct, OF_EXIST)
If MyFile < 0 Then '文件已经不存在，则提示错误。
MsgBox "写入错误！注册失败！" & Chr(13) & "注册期必须确保具有写入权限！请与你的管理员联系！" & Chr(13) & "如果还是不行，请重新安装本软件！", vbOKOnly, "错误.."
Unload Me
Exit Sub
End If
'测试文件大小。
MyFile = OpenFile(FileName, myOfstruct, OF_READ)
FileSize = GetFileSize(MyFile, TemNum)
CloseHandle MyFile
'打开文件并写入注册数据。
Open FileName For Binary Access Write As #1
If Err.Number <> 0 Then '打开文件错误。
MsgBox "写入错误！注册失败！" & Chr(13) & "注册期必须确保具有写入权限！请与你的管理员联系！", vbOKOnly, "错误.."
End If
Put #1, FileSize - 2, 598 \ 256
Put #1, FileSize - 1, 598 Mod 256
Close #1
'第二步，将注册信息写入注册表。
SaveString HKEY_CURRENT_USER, LOGON_REG_LOGON, "Using", "598" '写注册成功的标志数据（598 ）。
'SaveString HKEY_CURRENT_USER, LOGON_REG_PATH, "UserName", "User1" '修改系统登陆用户名和密码。
'SaveString HKEY_CURRENT_USER, LOGON_REG_PATH, "PassWord", "12345678"
'MsgBox "已经成功注册！" & Chr(13) & "系统登陆密码被重置为“12345678”！请记住此新密码。" & Chr(13) & "如果要更改密码，请利用“用户”菜单中的“密码修改”命令。", vbOKOnly, "注册成功..."
If ApplyMode = True Then
MsgBox "注册成功！" & Chr(13) & "感谢您使用<" & App.ProductName & ">软件！" & Chr(13) & "感谢您对国产软件的支持！", vbOKOnly, "注册成功"
Else
MsgBox "注册失败！" & Chr(13) & "请与你的系统管理员联系，以确保你有足够的权限！" & Chr(13) & "如果还是不行，请重新安装本软件！", vbOKOnly, "注册失败"
End If
Unload Me
Else
MsgBox "注册码有误！请输入正确的注册码！", vbOKOnly, "注册码错误"
End If
End If
Case 1:
Unload Me
Case 2:
Help
End Select
End Sub
Private Sub Form_Load()
Dim TemStr As String
'MsgBox "注册期间请关闭防毒程序及硬盘保护(还原)程序！" & Chr(13) & "否则会产生注册失败或重启后注册信息丢失的现象！", vbOKOnly, "<" & App.ProductName & "> 注册提示"
Me.Left = (Screen.Width - Me.Width) / 2 '置于屏幕正中。
Me.Top = (Screen.Height - Me.Height) / 2
Me.Caption = App.ProductName & " <软件注册>"
Frame1(0).Visible = True '设置第一步显示内容（协议）。
Frame1(1).Visible = False '第二步内容暂隐藏。
Label4.Text = "<" & App.ProductName & ">最终用户许可证协议:" & vbCrLf & "电子版，电脑使用。" & vbCrLf & "给用户的通知：" & vbCrLf & " 这是一个合同。在本文末尾作出接受选择，表明阁下接受本协议的全部条款和条件。如果阁下不同意本协议的条款和条件，请在指定的地方拒绝此协议。那样阁下将不得使用此软件。" & vbCrLf & " <" & App.ProductName & ">最终用户许可证协议 (“协议”) 与软件 (“软件”) 及有关的书面说明材料 (“文件”) 为一个整体。“软件”一词亦包括许可阁下所使用软件的升级、修订版以及更新、增补和复制本。如阁下同意以下条款，将授予阁下使用有关软件和文件的非专有许可证：" & vbCrLf & "1. 软件使用。" & vbCrLf & " 阁下可将此软件安装在计算机的硬盘或其他存储设备中。" & vbCrLf & " 复制此软件的一个备份拷贝，但此拷贝不可在任何其他计算机上安装或使用。" & vbCrLf
Label4.Text = Label4.Text & "2. 版权： 此软件归软件制作者及其供应商所有。其结构、组织及编码均为作者及其供应商所有的有价值的商业秘密。此外，此软件受到中国版权法及国际条约规定保护。阁下必须象对待任何其它受版权法保护的材料（如书籍）一样对待此软件。除非属于“软件使用”部分所规定的情况，阁下不得复制此软件或文件。任何根据本协议的规定所复制的拷贝都必须在软件上或软件中载有相同的版权和其它产权提示。阁下同意不得修正、改编或翻译该软件。阁下还需同意不得逆向工程、反编译、反汇编、编制或传播该软件的注册机或以其它方式试图发现本软件的源代码或破解本软件的注册信息。商标的使用应符合惯例，包括标明商标拥有者的名字。商标仅可用于标明用此软件处理产生的印制品。任何商标的上述使用并不说明阁下对该商标享有商标拥有者的任何权利。除上述情况之外，本协议不授予阁下对此软件的任何知识产权。" & vbCrLf
Label4.Text = Label4.Text & "3. 转让： 阁下不得出租、租赁、分许可、或出借此软件或文件。但如果符合下列条件，阁下可将使用此软件的全部权利转让给另外一个人或法人：(1) 阁下必须向该人或该法人转让此协议、软件，包括所有拷贝、更新本、以前的版本、由本系统产生的数据文件的所有拷贝以及所有文件；(2) 阁下自己不保留任何拷贝，包括留在计算机中的拷贝亦不得保留；(3) 受让方接受此协议的条款和条件。" & vbCrLf
Label4.Text = Label4.Text & "4. 有限保用： 在阁下收到此软件九十（90）天内，其性能与文件中的说明相符。如欲提出保用索赔，阁下必须在此九十天内将此软件连同阁下购买此软件的收据复印件一道退还原商店。如果此软件的性能与文件中的说明不符，全部的、唯一的责任与补救方法仅限以下两者之一：即更换软件或退还阁下已支付的软件使用许可费，由供应商决定采用哪一种方式。不保证，也无法保证阁下在使用此软件及文件时可能产生的功效或结果。以上所述是软件作者及其供应商对其保用失信所承诺的仅有的和全部的补偿。除上述有限保用外，软件作者及其供应商不作明示或暗示的任何其它保证，如不侵犯第三方权利或销售力，或软件适用于任何特殊用途。在允许的范围之内，任何暗示的保证期间不超过九十（90）天。此保证给予阁下特定的法律权利。" & vbCrLf
Label4.Text = Label4.Text & "5. 赔偿责任： 在任何情况下，软件作者及其供应商均不对下列情况负赔偿责任：一切后续的、偶然的、或特殊的损害，包括利润或者节约部分的损失，即使已被告知了此类损害的可能性，亦不得例外。另外，对于第三方提出的索赔要求亦不予赔偿。" & vbCrLf & "6. 适用法律： 此协议的适用法律为中国版权法、商标法及其它相关法律。如发现此协议的任何部分无效或无法实施，将不影响此协议其它部分的有效性，因而其它部分根据其条款规定仍然有效并应予以实施。如阁下违反此协议的规定，此协议将自动终止。"
Text2.Text = ""
Text3.Visible = False
Option1(1).Value = True: Command1(0).Enabled = False
Label2(2).Caption = " 如果您是通过正常渠道购买本软件，请拨打电话，将下面的申请码告知软件作者，从而获取一个合法的注册码，获取方法详见帮助文档。如果您已经拥有一个注册码，则请将其填在相应的文本框中，然后按下“注册”按钮进行注册。" & vbCrLf & "联系电话：13550788518"
TemStr = GetString(HKEY_CURRENT_USER, LOGON_REG_APPLY, "Apply") '获取申请码.
Label3.Caption = TemStr
'对注册表中的申请码进行校验，以防止非法解密。
TemStr = Mid(TemStr, 13, 2) & Mid(TemStr, 11, 2) & Mid(TemStr, 8, 2) & Mid(TemStr, 6, 2) & Mid(TemStr, 18, 2) & Mid(TemStr, 16, 2) & Mid(TemStr, 3, 2) & Mid(TemStr, 1, 2)
If Len(TemStr) < 16 Or TemStr <> GetString(HKEY_CURRENT_USER, LOGON_REG_LOGON, "Verify") Then
MsgBox "发现注册信息损坏！" & Chr(13) & "本机注册信息专属本机使用，用户不得试图通过修改注册信息非法使用本软件！" & Chr(13) & "如果非法对本软件进行解密，将受到法律的严惩！" & Chr(13) & "受损信息已经清除，现在重新给出一个申请码，请重新启动本软件，通过正常渠道进行注册！" & Chr(13) & "如因不明原因造成，请及时通知我们，联系方法详见帮助文档。"
TemStr = LogonIn() '随机获取一个申请码字符串。
SaveString HKEY_CURRENT_USER, LOGON_REG_APPLY, "Apply", TemStr '保存申请码原本。
TemStr = Mid(TemStr, 13, 2) & Mid(TemStr, 11, 2) & Mid(TemStr, 8, 2) & Mid(TemStr, 6, 2) & Mid(TemStr, 18, 2) & Mid(TemStr, 16, 2) & Mid(TemStr, 3, 2) & Mid(TemStr, 1, 2)
SaveString HKEY_CURRENT_USER, LOGON_REG_LOGON, "Verify", TemStr '错位保存申请，注册时进行校对，以防止解密者通过搜索注册表蒙混过关。
Help '如果发现注册信息错误,则自动显示帮助,同时退出应用程序.
End
End If
End Sub
Private Sub Image1_DblClick() '超级用户注册用。在第二步中单击左上角，然后在上部输入密码，再次单击即可。
Dim TempStr As String
Text3.BackColor = Frame1(1).BackColor '使密码输入框及其中的字符与背景相同。
Text3.ForeColor = Text3.BackColor
Text3.Visible = True '显示密码输入框。
Text3.Locked = False '允许输入密码。
Text3.PasswordChar = "*" '所输入的密码全部以“*”号显示。
Text2.SetFocus '将焦点设置到密码输入框。
If Text3.Text = "sbcel*19730613" Then '检查所输入的密码是否正确。
Text3.Text = ""
Text2.Text = ""
TempStr = InputBox("请输入您的申请码！", "获取注册码", "")
If TempStr <> "" Then Text2.Text = LogonOut(TempStr)
Text2.SetFocus
Text2.SelStart = Len(Text2.Text)
End If
End Sub
Private Sub Label1_Click(Index As Integer) '处理用户是否接受协议条款的选择。
Option1(Index).Value = True
End Sub
Private Sub Option1_Click(Index As Integer) '处理用户是否接受协议条款的选择。
Command1(0).Enabled = Option1(0).Value
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?