📄 frmlogin.frm
字号:
VERSION 5.00
Begin VB.Form frmLogin
BorderStyle = 1 'Fixed Single
Caption = "用户登录"
ClientHeight = 3165
ClientLeft = 45
ClientTop = 330
ClientWidth = 4815
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3165
ScaleWidth = 4815
StartUpPosition = 2 '屏幕中心
Begin VB.Frame fr
Height = 3225
Left = 0
TabIndex = 0
Top = -60
Width = 4815
Begin VB.PictureBox pic
Appearance = 0 'Flat
BackColor = &H00808080&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 825
Index = 0
Left = 1300
ScaleHeight = 825
ScaleWidth = 3495
TabIndex = 10
Top = 90
Width = 3495
Begin VB.Label lbl
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "企业内部业务联系系统 1.0"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 210
Index = 2
Left = 600
TabIndex = 14
Top = 450
Width = 2730
End
Begin VB.Label lbl
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "企业内部业务联系系统 1.0"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 3
Left = 630
TabIndex = 13
Top = 480
Width = 2730
End
Begin VB.Label lbl
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "欢迎使用"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 210
Index = 0
Left = 180
TabIndex = 12
Top = 120
Width = 900
End
Begin VB.Label lbl
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "欢迎使用"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 1
Left = 210
TabIndex = 11
Top = 150
Width = 900
End
End
Begin VB.CommandButton cmdExit
Caption = "退出(&E)"
Height = 375
Left = 3390
TabIndex = 5
Top = 2670
Width = 1155
End
Begin VB.CommandButton cmdLogin
Caption = "登录(&O)"
Default = -1 'True
Height = 375
Left = 2160
TabIndex = 4
Top = 2670
Width = 1155
End
Begin VB.TextBox txt
Height = 270
IMEMode = 3 'DISABLE
Index = 2
Left = 2610
PasswordChar = "*"
TabIndex = 3
Text = "Admin123!!!"
Top = 2130
Width = 1995
End
Begin VB.TextBox txt
Height = 270
Index = 1
Left = 2610
TabIndex = 2
Text = "Admin"
Top = 1740
Width = 1995
End
Begin VB.TextBox txt
Height = 270
Index = 0
Left = 2610
TabIndex = 1
Text = "127.0.0.1"
Top = 1350
Width = 1995
End
Begin VB.PictureBox pic
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 3105
Index = 1
Left = 30
Picture = "frmLogin.frx":0000
ScaleHeight = 3105
ScaleWidth = 1275
TabIndex = 6
Top = 90
Width = 1275
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "登录密码："
Height = 180
Index = 6
Left = 1530
TabIndex = 9
Top = 2190
Width = 900
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "用户名："
Height = 180
Index = 5
Left = 1530
TabIndex = 8
Top = 1800
Width = 720
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "服务器地址："
Height = 180
Index = 4
Left = 1530
TabIndex = 7
Top = 1410
Width = 1080
End
End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************
'* 企业内部业务联系系统 1.0版 *
'* *
'* 作者：郭文云(云南电信昭通分公司) *
'* 日期：2004年8月 *
'* 版权：Terrificsoft *
'* 版权所有 侵权必究 *
'****************************************
'为使用ADO方式连接数据库，先在“工程”---“引用(N)...”里添加引用"Microsoft ActiveX Data Objects 2.6 Library"
Option Explicit
'用户首次登录和重新登录
Private Sub cmdLogin_Click()
'连接到数据库并验证用户身份
If ConenctToDatabase And VerifyUser Then
'正在首次登录
On Error Resume Next
If LoginStat = 0 Then
frmMain.Show
DoEvents
Unload Me
'正在重新登录
ElseIf LoginStat = 1 Then
Dim i As Long
'卸载已经加载的窗体
For i = Forms.Count - 1 To 0 Step -1
Unload Forms(i)
Next i
frmMain.Show
DoEvents
End If
'登录完成
LoginStat = 2
End If
End Sub
'连接到数据库
Private Function ConenctToDatabase() As Boolean
On Error GoTo ErrorHandler
Dim DBName As String, ServerAdd As String, UserName As String, UserPwd As String
'设置连接信息字符串的参数
ServerAdd = txt(0)
DBName = "InfoProcSystem"
UserName = "sa"
UserPwd = ""
'连接数据库
Set AdoCon = New ADODB.Connection
AdoCon.ConnectionTimeout = 10
AdoCon.CursorLocation = adUseServer
AdoCon.ConnectionString = "uid=" & UserName & ";pwd=" & UserPwd & _
";driver={SQL Server};server=" & ServerAdd & _
";database=" & DBName & ";dsn=''"
AdoCon.Open
'返回值
ConenctToDatabase = True
Exit Function
ErrorHandler:
MsgBox "连接到数据库出错", vbCritical, "出现错误"
Exit Function
End Function
'验证用户身份
Private Function VerifyUser() As Boolean
On Error GoTo ErrorHandler
Dim strSQL As String
'构建检索用户信息的查询语句
strSQL = "SELECT * FROM tblUser "
strSQL = strSQL & "WHERE UserName='" & txt(1) & "' AND UserPwd='" & txt(2) & "'"
'获取记录
Set RsAdo = New ADODB.Recordset
RsAdo.Open strSQL, AdoCon, adOpenStatic, adLockReadOnly
'如果结果集为空，则用户身份非法
If RsAdo.EOF Then
MsgBox "用户名或密码错误，请重新输入！", vbCritical, "用户登录"
txt(1).SetFocus
Exit Function
End If
'如果结果集不为空，则用户合法，
'此时获取与用户名对应的用户信息，用来控制权限
UserDept = RsAdo("DeptUserIn")
UserName = RsAdo("TrueName")
CloseRsAdo
VerifyUser = True
Exit Function
ErrorHandler:
MsgBox "验证用户信息出错", vbCritical, "出现错误"
Exit Function
End Function
Private Sub Form_Load()
If App.PrevInstance Then End '如果程序已经运行，那么则结束以使该程序只能运行一个实例
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
'用户首次登录时才提示是否退出
If Forms.Count = 1 Then
If MsgBox("您确定要退出本系统吗？", vbInformation + vbYesNo, "退出系统") = vbYes Then
AdoCon.Close
End
Else: Cancel = 1 '取消卸载窗体
End If
End If
End Sub
'文本框被激活时，选定所有文本
Private Sub txt_GotFocus(Index As Integer)
txt(Index).SelStart = 0 '选定文本块的起始位置（为该文本的第0个位置）
txt(Index).SelLength = Len(txt(Index)) '所选的字符个数（为txt(Index)的长度）
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -