📄 frmlogin.frm
字号:
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form FrmLogin
BorderStyle = 3 'Fixed Dialog
Caption = "登录"
ClientHeight = 3000
ClientLeft = 45
ClientTop = 330
ClientWidth = 4995
Icon = "FrmLogin.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3000
ScaleWidth = 4995
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.Timer Timer3
Interval = 3000
Left = 0
Top = 0
End
Begin VB.Timer Timer2
Interval = 500
Left = 1200
Top = 1320
End
Begin VB.CommandButton CmdLogin
Caption = "登录(&L)"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3720
TabIndex = 7
Top = 1380
Width = 1095
End
Begin VB.TextBox TxtCZYDH
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1920
TabIndex = 6
Top = 1440
Width = 1575
End
Begin VB.TextBox TxtPassWord
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
IMEMode = 3 'DISABLE
Left = 1920
PasswordChar = "*"
TabIndex = 5
Top = 1800
Width = 1575
End
Begin VB.CommandButton CmdLoginCancel
Caption = "取消(&C)"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3720
TabIndex = 4
Top = 1800
Width = 1095
End
Begin VB.Timer Timer1
Interval = 50
Left = 240
Top = 120
End
Begin VB.PictureBox Picture1
BorderStyle = 0 'None
Height = 615
Left = 0
Picture = "FrmLogin.frx":0442
ScaleHeight = 615
ScaleWidth = 5055
TabIndex = 2
Top = 0
Width = 5055
End
Begin VB.PictureBox Picture2
BorderStyle = 0 'None
Height = 135
Left = 0
Picture = "FrmLogin.frx":A7E4
ScaleHeight = 135
ScaleWidth = 5055
TabIndex = 0
Top = 600
Width = 5055
Begin VB.PictureBox Picture3
BorderStyle = 0 'None
Height = 135
Left = 0
Picture = "FrmLogin.frx":C04A
ScaleHeight = 135
ScaleWidth = 5055
TabIndex = 1
Top = 0
Width = 5055
End
End
Begin RichTextLib.RichTextBox RichTextBox1
Height = 615
Left = 960
TabIndex = 3
TabStop = 0 'False
Top = 2355
Width = 4095
_ExtentX = 7223
_ExtentY = 1085
_Version = 393217
BackColor = -2147483644
BorderStyle = 0
Appearance = 0
TextRTF = $"FrmLogin.frx":D874
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label Label2
Caption = "请输入操作员代号和密码......"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 840
TabIndex = 11
Top = 840
Width = 3735
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "操作员:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 0
Left = 960
TabIndex = 10
Top = 1485
Width = 855
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "密 码:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 1
Left = 960
TabIndex = 9
Top = 1845
Width = 855
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "注意："
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Left = 120
TabIndex = 8
Top = 2355
Width = 735
End
Begin VB.Line Line2
BorderColor = &H00FF0000&
X1 = 120
X2 = 4920
Y1 = 2265
Y2 = 2265
End
Begin VB.Image Image1
Height = 480
Left = 240
Picture = "FrmLogin.frx":DB6D
Top = 1530
Width = 480
End
Begin VB.Line Line1
BorderColor = &H00FF0000&
X1 = 120
X2 = 4920
Y1 = 1200
Y2 = 1200
End
End
Attribute VB_Name = "FrmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public tNum As Integer
'使用本模块需包含 gLoginSuccess 、MdlRegister、MdlLogin、ColseDB、g_User_Info的定义
Private Sub CmdLogin_Click()
On Error GoTo Err
Dim t_Rtn_String As String
Dim t_Rtn_Code As Integer
Call RegSetString(HKEY_LOCAL_MACHINE, gRegSubKey + "\Option", "UserName", Trim(TxtCZYDH.Text))
t_Rtn_Code = Login(Trim(TxtCZYDH.Text), TxtPassWord.Text, t_Rtn_String, g_User_Info)
'函数返回：1 登录成功 非1登录失败 2 操作员被锁定 3 口令不正确
'4 3次不正确，锁定 5 操作员不存在 6 系统无操作员 7操作员正在使用中
If t_Rtn_Code <> 1 Then '登录不成功
Select Case t_Rtn_Code
Case 2, 7, 5, 8
MsgBox t_Rtn_String, vbExclamation, "登录提示"
TxtCZYDH.SetFocus
GoTo SkipTo '继续登录
Case 3
MsgBox t_Rtn_String, vbExclamation, "登录提示"
TxtPassWord.SetFocus
GoTo SkipTo '继续登录
Case 6
MsgBox "第一次使用本系统，请先建立用户", vbExclamation, "登录提示"
GoTo Success
Case 4
GoTo Err
End Select
End If
'登录成功检查是否有权限
If Check_Operate_Permission(CStr(g_User_Info.User_ID), "1007") = False Then
t_Rtn_String = "您输入的操作员没有权限，系统终止"
GoTo Err
End If
Success:
gLoginSuccess = True
gUserPwd = TxtPassWord
'AddEventLog 1001, "系统管理登录"
Unload Me
Exit Sub
Err:
If t_Rtn_String = "" Then
MsgBox "登录失败系统终止", vbExclamation, "登录提示"
Else
MsgBox t_Rtn_String, vbExclamation, "登录提示"
End If
Call CloseDB
End
SkipTo: '第一次运行系统
gLoginSuccess = False
End Sub
Private Sub CmdLoginCancel_Click()
Call CloseDB
End
End Sub
Private Sub Form_Activate()
Dim tStr As String
Call RegGetString(HKEY_LOCAL_MACHINE, gRegSubKey + "\Option", "UserName", tStr)
TxtCZYDH = tStr
TxtPassWord.SetFocus
End Sub
Private Sub Timer1_Timer()
Picture3.Left = Picture3.Left + 50
If Picture3.Left > Picture2.Left + Picture2.Width Then
Picture3.Left = Picture2.Left - Picture3.Width
End If
End Sub
Private Sub Timer2_Timer()
Dim i As Integer
Dim tStr As String
If tNum < 6 Then
tNum = tNum + 1
Else
tNum = 1
End If
For i = 1 To tNum
tStr = tStr + "."
Next i
Label2.Caption = "请输入操作员代号和密码" + tStr
End Sub
Private Sub Timer3_Timer()
If FrmSplash.Visible = True Then Unload FrmSplash
End Sub
Private Sub TxtCZYDH_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Or KeyCode = 40 Then
TxtPassWord.SetFocus
End If
End Sub
Private Sub TxtPassWord_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Call CmdLogin_Click
ElseIf KeyCode = 38 Then
TxtCZYDH.SetFocus
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -