📄 frmlogon.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmLogon
BorderStyle = 1 'Fixed Single
Caption = "[用户登录认证]"
ClientHeight = 3615
ClientLeft = 45
ClientTop = 330
ClientWidth = 4185
ControlBox = 0 'False
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3615
ScaleWidth = 4185
StartUpPosition = 2 '屏幕中心
Begin MSComctlLib.ImageList ImageList1
Left = 1980
Top = 1530
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmLogon.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmLogon.frx":031C
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmLogon.frx":0770
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmLogon.frx":0BC4
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmLogon.frx":0EE0
Key = ""
EndProperty
EndProperty
End
Begin VB.CommandButton cmdRejigger
Caption = "修改[&F]"
Height = 330
Left = 2820
Style = 1 'Graphical
TabIndex = 11
Tag = "确定"
Top = 2160
Width = 1020
End
Begin VB.TextBox txtUserName
BackColor = &H00FFFFFF&
Height = 270
Left = 2160
TabIndex = 0
Top = 240
Width = 1485
End
Begin VB.TextBox txtPassword
BackColor = &H00FFFFFF&
Height = 270
IMEMode = 3 'DISABLE
Left = 2160
MaxLength = 8
PasswordChar = "*"
TabIndex = 1
Top = 660
Width = 1485
End
Begin VB.TextBox txtNewPwd
Height = 270
IMEMode = 3 'DISABLE
Index = 0
Left = 1410
MaxLength = 8
PasswordChar = "*"
TabIndex = 10
TabStop = 0 'False
Top = 2190
Width = 1365
End
Begin VB.TextBox txtNewPwd
Height = 270
IMEMode = 3 'DISABLE
Index = 1
Left = 1410
MaxLength = 8
PasswordChar = "*"
TabIndex = 9
TabStop = 0 'False
Top = 2580
Width = 1365
End
Begin VB.CommandButton cmdOption
Cancel = -1 'True
Caption = "选项>>"
Height = 330
Left = 1650
Style = 1 'Graphical
TabIndex = 3
Tag = "取消"
Top = 1170
Width = 1020
End
Begin VB.CommandButton cmdCancel
Caption = "取消[&C]"
Height = 330
Left = 2820
Style = 1 'Graphical
TabIndex = 4
Tag = "取消"
Top = 1170
Width = 1020
End
Begin VB.CommandButton cmdOK
Caption = "确定[&O]"
Height = 330
Left = 540
Style = 1 'Graphical
TabIndex = 2
Tag = "确定"
Top = 1170
Width = 1020
End
Begin VB.Image Image1
Height = 630
Left = 240
Picture = "frmLogon.frx":1334
Stretch = -1 'True
Top = 180
Width = 690
End
Begin VB.Line Line1
X1 = 270
X2 = 3960
Y1 = 1890
Y2 = 1890
End
Begin VB.Label lblLabels
BackStyle = 0 'Transparent
Caption = "确认密码(&F):"
Height = 255
Index = 3
Left = 240
TabIndex = 8
Tag = "密码(&P):"
Top = 2610
Width = 1080
End
Begin VB.Label lblLabels
BackStyle = 0 'Transparent
Caption = "新密码(&N):"
Height = 255
Index = 2
Left = 240
TabIndex = 7
Tag = "密码(&P):"
Top = 2220
Width = 1080
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密码(&P):"
Height = 180
Index = 1
Left = 1080
TabIndex = 6
Tag = "密码(&P):"
Top = 690
Width = 750
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户名(&U):"
Height = 180
Index = 0
Left = 1080
TabIndex = 5
Tag = "用户名(&U):"
Top = 270
Width = 900
End
End
Attribute VB_Name = "frmLogon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sUid As String
Dim ErrTimes As Integer
Dim bLogon As Boolean
Private Sub cmdCancel_Click()
bLogon = False
Unload Me
End Sub
Private Sub cmdOK_Click()
If Not bLogonSpecialSet Then
If ErrTimes = 2 Then
MsgBox "三次密码错误，无法进入此模块!", , "认证"
Unload Me
Exit Sub
End If
MsgBox "密码输入错误，请重新输入", , "认证"
ErrTimes = ErrTimes + 1
txtPassword.SetFocus
txtPassword.SelStart = 0
txtPassword.SelLength = Len(txtPassword.Text)
Exit Sub
Else
mdifrmMain.Show
End If
Unload Me
'
End Sub
Private Sub cmdOption_Click()
If Height = 3405 Then
Height = 2115
cmdOption.Caption = "选项>>"
Else
If bLogonSpecialSet Then
bLogon = True
Else
bLogon = False
MsgBox "密码输入错误，请重新输入", , "认证"
End If
If bLogon Then
Height = 3405
cmdOption.Caption = "选项<<"
End If
End If
End Sub
Public Function bLogonSpecialSet() As Boolean
Dim rs As New ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "select * from ZY_users where UPPER(uid)='" + UCase(Trim(txtUserName)) + "' and UPPER(password)='" + UCase(Trim(txtPassword)) + "'", cnn, adOpenStatic, adLockOptimistic
If Not rs.EOF Then
bLogonSpecialSet = True
cCheckOP = Trim(txtUserName)
cCheckName = rs.Fields("username")
Exit Function
End If
If UCase(Trim(txtUserName)) = UCase("Administrator") And UCase(Trim(txtPassword)) = UCase("Admin") Then
bLogonSpecialSet = True
End If
End Function
Private Sub cmdRejigger_Click()
Dim rs As New ADODB.Recordset
If Trim(txtNewPwd(0)) <> Trim(txtNewPwd(1)) Then
bLogon = False
MsgBox "不会吧,你的两次密码竟然不同!", , "认证"
Exit Sub
End If
sUid = Trim(txtUserName)
If bLogonSpecialSet Then
rs.Open "ZYSP_UPDATE_USERS '" + sUid + "','" + Trim(txtNewPwd(1)) + "'", cnn, adOpenStatic, adLockOptimistic
MsgBox "密码修改成功!", , "登录"
Height = 2115
txtPassword = txtNewPwd(0)
cmdOK.Default = True
Else
bLogon = False
MsgBox "密码输入错误，请重新输入", , "认证"
txtNewPwd(0).SelLength = Len(txtPassword)
End If
End Sub
Private Sub Form_Load()
Dim strcnn As String
ErrTimes = 0
bLogon = False
Height = 2115
Dim aaa As String * 500
Dim aa As String
Dim a As String * 2
'''' Open App.Path + "\AmcSource.dll" For Binary Access Read Write As #1
'''''///////////
''''
'''' aa = "provider=SQLOLEDB.1;Password=3310;Persist Security Info=True;User ID=AMC;Initial Catalog=zz_amc;Data Source=zzgj-sqlsvr"
'''' For i = 1 To Len(aa)
'''' aB = aB + Hex(Asc(Mid(aa, i, 1)))
'''' Next i
'''' Close #1
'HAN
' Open App.Path + "\AmcSource.dll" For Binary Access Read Write As #1
' Get 1, 1, aaa
' aa = Trim(aaa)
' For i = 1 To Len(aa) Step 2
' If Trim(Mid(aa, i, 2)) <> a Then
' strcnn = strcnn + Chr("&h" + Mid(aa, i, 2))
' Else
' i = Len(aa)
' End If
' Next i
' Close #1
' strCollection = strcnn
strCollection = "Provider=SQLOLEDB.1;Password=EGMCCZhongYin;Persist Security Info=True;User ID=jzbus;Initial Catalog=zz_amc;Data Source=dbsrvp"
zzstrCollection = "Provider=SQLOLEDB.1;Password=EGMCCZhongYin;Persist Security Info=True;User ID=jzbus;Initial Catalog=zz_BUS_IC;Data Source=dbsrvp"
'strCollection = "Provider=SQLOLEDB.1;Password=EGMCCZhongYin;Persist Security Info=True;User ID=jzbus;Initial Catalog=zz_amc;Data Source=programe"
cnn.CommandTimeout = 300
cnn.ConnectionTimeout = 300
cnn.Open strCollection
End Sub
'补0函数
Public Function Supply00(ByVal sOldStr As String, ByVal SupplyWay As Integer, ByVal SupplyChar As String, ByVal SupplyNum As Long) As String
Dim i As Integer, stmp As String
For i = Len(sOldStr) To SupplyNum - 1
stmp = stmp & SupplyChar
Next i
Select Case SupplyWay
Case 0 '前补充
stmp = stmp & sOldStr
Case 1 '后补充
stmp = sOldStr & stmp
Case Else
stmp = sOldStr
End Select
Supply00 = stmp
End Function
Public Function SHex(ByVal iIn As Integer) As String
Dim stmp As String
stmp = Supply00(Hex(iIn), 0, "0", 2)
SHex = stmp
End Function
Private Sub txtNewPwd_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
Case 0
If KeyAscii = 13 Then
txtNewPwd(0).SetFocus
cmdRejigger.Default = True
End If
Case 1
If KeyAscii = 13 Then
txtNewPwd(1).SetFocus
End If
End Select
End Sub
Private Sub txtPassword_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdOK.Default = True
'cmdOK.SetFocus
End If
End Sub
Private Sub txtUserName_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtPassword.SetFocus
cmdOK.Default = True
Else
KeyAscii = clsDaivd.ValiText(KeyAscii, "0123456789", True)
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -