frmsyslogin.frm
来自「通用书店管理系统」· FRM 代码 · 共 228 行
FRM
228 行
VERSION 5.00
Begin VB.Form frmSysLogin
BorderStyle = 3 'Fixed Dialog
Caption = "登录"
ClientHeight = 2010
ClientLeft = 2835
ClientTop = 3480
ClientWidth = 4380
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Moveable = 0 'False
ScaleHeight = 1187.576
ScaleMode = 0 'User
ScaleWidth = 4112.583
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdDB
Caption = "选项"
Height = 339
Left = 2880
TabIndex = 6
Top = 1440
Width = 852
End
Begin VB.TextBox txtUserName
Height = 270
Left = 1320
MaxLength = 10
TabIndex = 0
Top = 240
Width = 2535
End
Begin VB.CommandButton cmdOK
Caption = "确定"
Default = -1 'True
Height = 339
Left = 480
TabIndex = 2
Top = 1440
Width = 852
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取消"
Height = 339
Left = 1680
TabIndex = 3
Top = 1440
Width = 855
End
Begin VB.TextBox txtPassword
Height = 270
IMEMode = 3 'DISABLE
Left = 1320
MaxLength = 20
PasswordChar = "*"
TabIndex = 1
Top = 840
Width = 2535
End
Begin VB.Label lblLabels
Caption = "用户名(&U):"
Height = 255
Index = 0
Left = 360
TabIndex = 4
Top = 285
Width = 1080
End
Begin VB.Label lblLabels
Caption = "密码(&P):"
Height = 270
Index = 1
Left = 360
TabIndex = 5
Top = 885
Width = 1080
End
End
Attribute VB_Name = "frmSysLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private i As Integer
Public blnLoginOK As Boolean
Private Sub cmdCancel_Click()
' If blnLogin Then
' blnLogin = False
' End If
Me.Hide ' 隐藏窗口
End Sub
Private Sub cmdDB_Click()
' If txtPassword.Text = EnCrypt_conPWD(Trim(txtUserName.Text) & Format(Date, "yyyy-MM-dd")) Then
frmDBconfirm.Show vbModal
' Else
' MsgBox "要修改数据库连接配置,请输入正确的用户名与密码...", vbInformation
' End If
End Sub
Private Sub cmdOK_Click() '检查正确的密码
Dim strPWD As String
Dim rs As ADODB.Recordset ' lzw 用于返回用户姓名
On Error GoTo Err
' If ghcon.State = adStateClosed Then
' Call setDBConnect(ghcon)
' End If
If Len(txtUserName.Text) = 0 Then
MsgBox "用户名为空,请输入.."
txtUserName.SetFocus
SendKeys "{Home}+{End}"
Exit Sub
End If
If Len(txtPassword.Text) = 0 Then
' MsgBox "密码为空,请输入.."
txtPassword.SetFocus
' SendKeys "{Home}+{End}"
Exit Sub
End If
'strSql = "select chrCompanyName from Company where chrCompanyName='阳光书社' or chrCompanyName='南郑县教育书店'" ' lzw 2002-06-25
' strSql = "select chrCompanyName from Company where chrCompanyName='试用书店'"
strSql = "select chrCompanyName from Company"
Set rs = cN.Execute(strSql, , 1)
If rs.EOF Then
MsgBox "您是非法用户,拒绝登录!", vbCritical + vbOKOnly
Me.Hide
Exit Sub
Else
strCompanyName = rs("chrCompanyName")
End If
Set rs = Nothing
strPWD = txtPassword.Text
'If checkuser(ghcon, txtUserName.Text, strpwd) Then
If checkuser(txtUserName, strPWD, "书店管理系统") Then
'If Mid(strpwd, 1, 1) = "*" And strLoginUserID <> "admin" Then lzw remark
If Mid(strPWD, 1, 1) = "*" And txtUserName <> "admin" Then
' blnchgpwd = True '更改密码
MsgBox "您必须更改密码后才能登录系统。", vbInformation + vbOKOnly, "成本核算系统"
'frmChangePWD.Show vbModal lzw remark
frmchpwd.Show vbModal
' lzw 暂时不要下段
' If Not blnchgpwd Then
'' MsgBox "第一次登录系统,请先修改您的密码...", , "密码修改"
' Me.Hide
' blnLogin = False
' Exit Sub
' End If
End If
' lzw 暂时不要下段
' If Mid(strpwd, 1, 1) = "#" Or Mid(strpwd, 1, 1) = "-" Then
' MsgBox "您的帐号已被禁止,请与管理员联系...", vbExclamation
' Me.Hide ' lzw
' blnLogin = False
' Exit Sub
' End If
'blnLogin = True remark
' lzw 增加返回用户名操作
strSql = "select chrtruename from tau_users where chrusername='" & Trim(txtUserName.Text) & "'"
Set rs = cN.Execute(strSql, , 1)
If Not rs.EOF Then
strUserTrueName = rs("chrtruename")
Else
strUserTrueName = ""
End If
Set rs = Nothing
blnLoginOK = True
Me.Hide
Exit Sub
Else
' blnLogin = False remark
i = i + 1
If i > 3 Then
MsgBox "您是非法用户,被拒绝登录!", vbCritical + vbOKOnly
Me.Hide
Exit Sub
Else
MsgBox "用户代码和密码无效,请重试!", , "登录"
txtPassword.SetFocus
SendKeys "{Home}+{End}"
Exit Sub
End If
End If
' blnLoginOK = True ' 登录成功
' Me.Hide ' 隐藏窗口
Exit Sub
Err:
MsgBox "程序出错:" & Err.Description & "请与系统管理员联系...", vbInformation, "出错信息"
' Call KillForm("frmSplash")
End Sub
Private Sub Form_Load()
blnLoginOK = False
i = 0
End Sub
Private Sub txtPassword_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call EnterToTab(KeyAscii, True)
End Sub
Private Sub txtUserName_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call EnterToTab(KeyAscii, True)
End Sub
Private Sub txtworknum_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call EnterToTab(KeyAscii, True)
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?