📄 frm数据系统验证.frm
字号:
VERSION 5.00
Begin VB.Form frm数据系统验证
BorderStyle = 0 'None
Caption = "Form2"
ClientHeight = 11520
ClientLeft = 0
ClientTop = 0
ClientWidth = 15360
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form2"
ScaleHeight = 11520
ScaleWidth = 15360
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.Timer Timer1
Interval = 1000
Left = 0
Top = 0
End
Begin VB.TextBox KeyTxt
BeginProperty Font
Name = "Verdana"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
IMEMode = 3 'DISABLE
Index = 5
Left = 11880
MaxLength = 4
TabIndex = 10
Top = 5880
Visible = 0 'False
Width = 1215
End
Begin VB.CommandButton validCmd
Caption = "确定"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 585
Left = 5670
TabIndex = 11
Top = 8640
Width = 1935
End
Begin VB.TextBox KeyTxt
BeginProperty Font
Name = "Verdana"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
IMEMode = 3 'DISABLE
Index = 4
Left = 10320
MaxLength = 4
TabIndex = 9
Top = 5880
Visible = 0 'False
Width = 1245
End
Begin VB.TextBox KeyTxt
BeginProperty Font
Name = "Verdana"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
IMEMode = 3 'DISABLE
Index = 3
Left = 8760
MaxLength = 4
TabIndex = 8
Top = 5880
Visible = 0 'False
Width = 1275
End
Begin VB.TextBox KeyTxt
BeginProperty Font
Name = "Verdana"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
IMEMode = 3 'DISABLE
Index = 2
Left = 7110
MaxLength = 4
TabIndex = 7
Top = 5880
Visible = 0 'False
Width = 1245
End
Begin VB.TextBox KeyTxt
BeginProperty Font
Name = "Verdana"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
IMEMode = 3 'DISABLE
Index = 1
Left = 5460
MaxLength = 4
TabIndex = 6
Top = 5910
Visible = 0 'False
Width = 1215
End
Begin VB.TextBox KeyTxt
BeginProperty Font
Name = "Verdana"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
IMEMode = 3 'DISABLE
Index = 0
Left = 3810
MaxLength = 4
TabIndex = 5
Top = 5880
Visible = 0 'False
Width = 1305
End
Begin VB.CommandButton quitCmd
Caption = "退出"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 585
Left = 8700
TabIndex = 1
Top = 8640
Width = 1845
End
Begin VB.Line Line9
BorderColor = &H00004080&
BorderWidth = 3
X1 = 13890
X2 = 13890
Y1 = 2760
Y2 = 8220
End
Begin VB.Line Line8
BorderColor = &H00004080&
BorderWidth = 3
X1 = 1590
X2 = 1590
Y1 = 2790
Y2 = 8190
End
Begin VB.Line Line7
BorderColor = &H00004080&
BorderWidth = 3
X1 = 1590
X2 = 13860
Y1 = 8190
Y2 = 8190
End
Begin VB.Line Line6
BorderColor = &H00004080&
BorderWidth = 3
X1 = 1590
X2 = 13860
Y1 = 2760
Y2 = 2760
End
Begin VB.Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "汽油车稳态加载排放污染物检测系统"
BeginProperty Font
Name = "楷体_GB2312"
Size = 21.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 3630
TabIndex = 12
Top = 3570
Width = 9165
End
Begin VB.Line Line5
Visible = 0 'False
X1 = 11580
X2 = 11820
Y1 = 6270
Y2 = 6270
End
Begin VB.Line Line2
Visible = 0 'False
X1 = 10020
X2 = 10260
Y1 = 6300
Y2 = 6300
End
Begin VB.Line Line4
Visible = 0 'False
X1 = 8430
X2 = 8670
Y1 = 6240
Y2 = 6240
End
Begin VB.Line Line3
Visible = 0 'False
X1 = 7020
X2 = 6780
Y1 = 6240
Y2 = 6240
End
Begin VB.Line Line1
Visible = 0 'False
X1 = 5130
X2 = 5370
Y1 = 6210
Y2 = 6210
End
Begin VB.Label SeriaNumLab
Alignment = 2 'Center
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "Verdana"
Size = 21.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 3600
TabIndex = 4
Top = 4440
Width = 9465
End
Begin VB.Label PwdLab
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "密码"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 2550
TabIndex = 3
Top = 5880
Visible = 0 'False
Width = 1035
End
Begin VB.Label seriaNoLab
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "序列号"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 2520
TabIndex = 2
Top = 4440
Width = 1095
End
Begin VB.Label MsgLab
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 675
Left = 2550
TabIndex = 0
Top = 6840
Width = 10545
End
End
Attribute VB_Name = "frm数据系统验证"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
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 ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Dim diskSeriaNo As Long
Dim seriaNo As String
Dim rs As ADODB.Recordset
Dim retrys As Integer
Const EWX_POWEROFF = 8
Dim dwReserved As Long
Dim ValidDate As Boolean
Dim nErrorTimes As Integer
Private Sub Form_Activate()
nErrorTimes = 0
MsgLab.Caption = "正在检查系统的合法性！"
ValidDate = False
Database.Class_Initialize
Call checkPrivage
End Sub
Private Sub Form_Load()
' nErrorTimes = 0
' MsgLab.Caption = "正在检查系统的合法性！"
' ValidDate = False
' Database.Class_Initialize
' Call checkPrivage
End Sub
Public Sub checkPrivage()
Dim tempNo As String
Dim tempkey As String
Dim OldKey As String
Dim findNext As Boolean
Dim ret As Integer
Dim x As Long
'On Error GoTo ErrHandle:
diskSeriaNo = GetSerialNumber("c:\")
Set rs = Database.取数据("select * from hylimit")
If rs.EOF Then
MsgLab.Caption = "你没有权利应用该系统，请按照序列号抄下传真到深圳汇银实业公司申请使用权限,在取得许可密码前不要退出此系统,否则需要抄下下次新的序列号，重新申请许可密码"
seriaNo = GetPruductSeriaNum(diskSeriaNo)
SeriaNumLab.Caption = GetDisplay(seriaNo)
Call Database.更新数据库("insert into hylimit (expiredLevel, diskNo,SeriaNo,desckey) values(0,'" & CStr(diskSeriaNo) & "','" & CStr(seriaNo) & "','123')")
Call setVisible
ValidDate = False
Exit Sub
End If
'新增功能:当已经全部付款,不需再验证序列号和密码 by Jackson
If rs.EOF = False Then
If IsNull(rs!reGisterdate) = False Then
If DateValue(CDate(rs!reGisterdate)) = CDate("2001-01-01") Then
Database.Class_Terminate
Unload Me
Set frm数据系统验证 = Nothing
frm数据第一屏计量环保认证标志.Show
Exit Sub
End If
End If
End If
'--------------------------
If rs!diskNo <> CStr(diskSeriaNo) Then
MsgLab.Caption = "你没有权利应用该系统，请按照序列号抄下传真到深圳汇银实业公司申请使用权限,在取得许可密码前不要退出此系统,否则需要抄下下次新的序列号，重新申请许可密码"
seriaNo = GetPruductSeriaNum(diskSeriaNo)
SeriaNumLab.Caption = GetDisplay(seriaNo)
rs.Close
Database.更新数据库 ("delete from hylimit")
Database.更新数据库 ("insert into hylimit (expiredLevel,diskNo,SeriaNo,desckey,TestType) values(0,'" & CStr(diskSeriaNo) & "','" & CStr(seriaNo) & "','123',1)")
Call setVisible
ValidDate = False
End If
seriaNo = rs!seriaNo
OldKey = rs!desckey
rs.Close
If ValidDays() = False Then
MsgBox ("你已经修改日期,系统将退出!错误代码4")
Database.Class_Terminate
x = ExitWindowsEx(EWX_POWEROFF, dwReserved)
End
Call ExitWindowsEx(EWX_SHUTDOWN, 0)
End If
ret = ValidDayDiff()
If ret > 5 Then
Database.Class_Terminate
Unload Me
Set frm数据系统验证 = Nothing
frm数据第一屏计量环保认证标志.Show
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -