📄 frmdlck.frm
字号:
VERSION 5.00
Begin VB.Form FrmDlck
BorderStyle = 1 'Fixed Single
Caption = "欢迎您"
ClientHeight = 3990
ClientLeft = 4050
ClientTop = 2220
ClientWidth = 4020
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3990
ScaleWidth = 4020
Begin VB.CommandButton Command3
Caption = "帮助(&H)"
Height = 375
Left = 2520
TabIndex = 12
Top = 3360
Width = 855
End
Begin VB.Frame Frame2
Caption = "数据库"
Height = 1335
Left = 240
TabIndex = 9
Top = 1800
Width = 3495
Begin VB.TextBox Text2
Height = 270
Left = 1320
TabIndex = 4
Top = 840
Width = 1935
End
Begin VB.ComboBox Combo2
Height = 300
ItemData = "FrmDlck.frx":0000
Left = 1320
List = "FrmDlck.frx":000D
Style = 2 'Dropdown List
TabIndex = 3
Top = 360
Width = 1935
End
Begin VB.Label Label4
Caption = "计算机名称："
Height = 255
Left = 240
TabIndex = 11
Top = 840
Width = 1215
End
Begin VB.Label Label3
Caption = "数据库类型："
Height = 375
Left = 240
TabIndex = 10
Top = 360
Width = 1095
End
End
Begin VB.CommandButton Command1
Caption = "确认(&O)"
Default = -1 'True
Height = 375
Left = 600
TabIndex = 5
Top = 3360
Width = 855
End
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "取消(&C)"
Height = 375
Left = 1560
TabIndex = 6
Top = 3360
Width = 855
End
Begin VB.Frame Frame1
Caption = "用户信息"
Height = 1335
Left = 240
TabIndex = 0
Top = 240
Width = 3495
Begin VB.ComboBox Combo1
Height = 300
ItemData = "FrmDlck.frx":0042
Left = 1320
List = "FrmDlck.frx":004F
Style = 2 'Dropdown List
TabIndex = 1
Top = 320
Width = 1935
End
Begin VB.TextBox Text1
Height = 270
IMEMode = 3 'DISABLE
Left = 1320
PasswordChar = "*"
TabIndex = 2
Top = 795
Width = 1935
End
Begin VB.Label Label1
Caption = "用户类型："
Height = 255
Left = 240
TabIndex = 8
Top = 360
Width = 1215
End
Begin VB.Label Label2
Caption = "密码："
Height = 255
Left = 240
TabIndex = 7
Top = 840
Width = 855
End
End
End
Attribute VB_Name = "FrmDlck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Combo1_Click()
Me.Caption = "欢迎您，" & Trim(Combo1.Text)
End Sub
Private Sub Combo2_Click()
If Combo2.ListIndex <> 0 Then
Label4.Enabled = True
Text2.Enabled = True
Else
Label4.Enabled = False
Text2.Enabled = False
Text2.Text = ""
End If
End Sub
'***************************************************************************************
' 过程：Command1_Click
' 功能：实现数据库连接和用户登录功能
'***************************************************************************************
Private Sub Command1_Click()
'SQL语句字符串
Dim strExec As String
'是否合法用户
Dim bValidUser As Boolean
'保存原来的鼠标指针
Dim iOldMousePointer As Integer
bValidUser = False
If (Combo2.ListIndex <> 0 And Text2.Text = "") Or _
Combo1.Text = "" Or Text1.Text = "" Then
MsgBox "输入信息不全！", vbCritical, "错误信息"
Text1.SetFocus
Exit Sub
End If
'创建全局的ADO Connection对象
Set objCon = CreateObject("ADODB.Connection")
'如果连接不成功，转UnableToConnect标签处
On Error GoTo UnableToConnect
'保存原有鼠标指针
iOldMousePointer = FrmDlck.MousePointer
'鼠标指针改为沙漏状
FrmDlck.MousePointer = 11
'Access数据库
If Combo2.ListIndex = 0 Then
objCon.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & _
App.Path & "\Student.MDB" & ";password=QingBT"
'SQL Server 数据库
ElseIf Combo2.ListIndex = 1 Then
objCon.Open "driver={SQL Server};SERVER=" & Text2.Text & _
";DATABASE=student"
'Oracle 数据库
Else
objCon.Open "provider=MSDAORA;SERVER=" & Text2.Text & _
";Data Source=Student;User ID=system;Password=manager;"
End If
'恢复原有鼠标指针形状
FrmDlck.MousePointer = iOldMousePointer
'查找对应的登录用户，并判断密码是否正确
Set objRs = CreateObject("ADODB.RecordSet")
Select Case Combo1.Text
Case "系统管理员"
strExec = "Select * From YHGLB Where yhjb=1"
Set objRs = objCon.Execute(strExec)
If Not objRs.EOF Then
If Trim(objRs("yhmm")) = Trim(Text1.Text) Then
bValidUser = True
numUserType = 1
End If
Else
MsgBox "没有找到密码信息！", vbCritical, "错误信息"
End If
Case "数据录入员"
strExec = "Select * From YHGLB Where yhjb=2"
Set objRs = objCon.Execute(strExec)
If Not objRs.EOF Then
If Trim(objRs("yhmm")) = Trim(Text1.Text) Then
bValidUser = True
numUserType = 2
End If
Else
MsgBox "没有找到密码信息！", vbCritical, "错误信息"
End If
Case "查询人员"
strExec = "Select * From YHGLB Where yhjb=3"
Set objRs = objCon.Execute(strExec)
If Not objRs.EOF Then
If Trim(objRs("yhmm")) = Trim(Text1.Text) Then
bValidUser = True
numUserType = 3
End If
Else
MsgBox "没有找到密码信息！", vbCritical, "错误信息"
End If
End Select
'合法用户
If bValidUser Then
objRs.Close
'关闭登录窗口
Unload FrmDlck
'使主窗口可用
FrmMain.Enabled = True
FrmMain.Visible = True
'根据用户类型设置菜单和工具按钮的可用性
Select Case numUserType
Case 1
FrmMain.xtxx.Enabled = True
FrmMain.dalr.Enabled = True
FrmMain.cjlr.Enabled = True
FrmMain.cjpb.Enabled = True
FrmMain.kcxxwh.Enabled = True
FrmMain.kcap.Enabled = True
FrmMain.xbxxwh.Enabled = True
FrmMain.zyxxwh.Enabled = True
FrmMain.Toolbar1.Buttons(1).Enabled = True
FrmMain.Toolbar1.Buttons(7).Enabled = True
Case 2
FrmMain.xtxx.Enabled = False
FrmMain.dalr.Enabled = True
FrmMain.cjlr.Enabled = True
FrmMain.cjpb.Enabled = True
FrmMain.kcxxwh.Enabled = True
FrmMain.kcap.Enabled = True
FrmMain.xbxxwh.Enabled = True
FrmMain.zyxxwh.Enabled = True
FrmMain.Toolbar1.Buttons(1).Enabled = True
FrmMain.Toolbar1.Buttons(7).Enabled = True
Case 3
FrmMain.xtxx.Enabled = False
FrmMain.dalr.Enabled = False
FrmMain.cjlr.Enabled = fasle
FrmMain.cjpb.Enabled = fasle
FrmMain.kcxxwh.Enabled = fasle
FrmMain.kcap.Enabled = fasle
FrmMain.xbxxwh.Enabled = fasle
FrmMain.zyxxwh.Enabled = fasle
FrmMain.Toolbar1.Buttons(1).Enabled = False
FrmMain.Toolbar1.Buttons(7).Enabled = False
End Select
'非法用户
Else
MsgBox "密码错误，请重新登录！", vbCritical, "错误信息"
Text1.SetFocus
'选中输入内容
SendKeys "{Home}+{End}"
End If
Exit Sub
'无法连接数据库时转到此处处理
UnableToConnect:
FrmDlck.MousePointer = iOldMousePointer
MsgBox Err.Description
Exit Sub
End Sub
Private Sub Command2_Click()
Unload FrmDlck
End
End Sub
Private Sub Command3_Click()
Shell "hh.exe " & App.Path & "\help.chm::/2.htm", vbNormalFocus
End Sub
Private Sub Form_Load()
Combo1.ListIndex = 1
Me.Caption = "欢迎您，" & Trim(Combo1.Text)
Combo2.ListIndex = 0
Label4.Enabled = False
Text2.Enabled = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -