📄 frmlogin.frm
字号:
VERSION 5.00
Object = "{E95A2510-F3D1-416D-823B-4F840FE98091}#3.0#0"; "Command.ocx"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form frmLogin
BackColor = &H80000013&
BorderStyle = 0 'None
Caption = "登录"
ClientHeight = 3075
ClientLeft = 0
ClientTop = 0
ClientWidth = 4680
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3075
ScaleWidth = 4680
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin MSAdodcLib.Adodc Adodc1
Height = 330
Left = 2520
Top = 720
Width = 1215
_ExtentX = 2143
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin CSCommand.Command cmdCancel
Height = 495
Left = 2760
TabIndex = 5
Top = 2400
Width = 1215
_ExtentX = 2143
_ExtentY = 873
IconAlign = 0
Icon = "frmLogin.frx":0000
Caption = "取消"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BackStyle = 0
End
Begin CSCommand.Command cmdOK
Height = 495
Left = 480
TabIndex = 4
Top = 2400
Width = 1215
_ExtentX = 2143
_ExtentY = 873
IconAlign = 0
Icon = "frmLogin.frx":001C
Caption = "确定"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.TextBox txtPassword
Height = 375
IMEMode = 3 'DISABLE
Left = 1920
PasswordChar = "*"
TabIndex = 3
Text = "Text1"
Top = 1800
Width = 2535
End
Begin VB.ComboBox txtUserName
Height = 315
Left = 1920
TabIndex = 2
Text = "txtUserName"
Top = 1080
Width = 2535
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "登录"
BeginProperty Font
Name = "楷体_GB2312"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 3015
Left = 0
TabIndex = 6
Top = 0
Width = 4695
End
Begin VB.Image Image2
Height = 480
Left = 240
Picture = "frmLogin.frx":0038
Stretch = -1 'True
Top = 1680
Width = 480
End
Begin VB.Image Image1
Height = 480
Left = 240
Picture = "frmLogin.frx":19BA
Stretch = -1 'True
Top = 960
Width = 480
End
Begin VB.Image Image3
Height = 735
Left = 0
Picture = "frmLogin.frx":333C
Stretch = -1 'True
Top = 0
Width = 4650
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "登陆密码："
Height = 375
Left = 840
TabIndex = 1
Top = 1800
Width = 1095
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "用户名称："
Height = 375
Left = 840
TabIndex = 0
Top = 1080
Width = 1095
End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
Public OK As Boolean
Dim txtSQL As String
Dim mrc As ADODB.Recordset
Dim MsgText As String
Dim miCount As Integer
Private Sub Form_Load()
Dim i As Integer
i = 0
txtSQL = "select * from user_Form"
Set mrc = ExecuteSQL(txtSQL, MsgText)
With txtUserName
Do While Not mrc.EOF
i = i + 1
.AddItem Trim(mrc!user_ID)
mrc.MoveNext
Loop
.ListIndex = i - 1
End With
mrc.Close
OK = False
miCount = 0
End Sub
Private Sub cmdCancel_Click()
OK = False
Me.Hide
End Sub
Private Sub cmdOK_Click()
txtSQL = "select * from user_Form where user_ID = '" & txtUserName.Text & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = True Then
MsgBox "没有这个用户，请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
txtUserName.SetFocus
Else
If Trim(mrc.Fields(1)) = Trim(txtPassword.Text) Then
OK = True
mrc.Close
Me.Hide
UserName = Trim(txtUserName.Text)
Else
MsgBox "输入密码不正确，请重新输入！", vbOKOnly + vbExclamation, "警告"
txtPassword.SetFocus
txtPassword.Text = ""
End If
End If
miCount = miCount + 1
If miCount = 3 Then
Me.Hide
End If
Exit Sub
End Sub
Private Sub txtPassword_KeyDown(KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End Sub
Private Sub txtPassword_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call cmdOK_Click
End If
End Sub
Private Sub txtUserName_Click()
txtPassword.Text = ""
End Sub
Private Sub txtUserName_KeyDown(KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -