?? 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 + -