📄 frmlogin.frm
字号:
VERSION 5.00
Begin VB.Form frmLogin
BorderStyle = 3 'Fixed Dialog
Caption = "登录"
ClientHeight = 2115
ClientLeft = 2835
ClientTop = 3480
ClientWidth = 4320
Icon = "frmLogin.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1249.612
ScaleMode = 0 'User
ScaleWidth = 4056.246
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox TXTInI
Height = 270
Left = 3900
TabIndex = 6
Text = "Text1"
Top = 1695
Visible = 0 'False
Width = 285
End
Begin VB.TextBox txtUserName
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 2010
TabIndex = 1
Text = "admin"
Top = 345
Width = 2040
End
Begin VB.CommandButton cmdOK
Caption = "确 定"
Default = -1 'True
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 885
TabIndex = 4
Top = 1545
Width = 1140
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取 消"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 2565
TabIndex = 5
Top = 1560
Width = 1140
End
Begin VB.TextBox txtPassword
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
IMEMode = 3 'DISABLE
Left = 2010
PasswordChar = "*"
TabIndex = 3
Text = "admin"
Top = 855
Width = 2040
End
Begin VB.Image Image1
Height = 675
Left = 300
Picture = "frmLogin.frx":030A
Stretch = -1 'True
Top = 210
Width = 630
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户名:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 0
Left = 1020
TabIndex = 0
Top = 405
Width = 915
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密码:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 1
Left = 1260
TabIndex = 2
Top = 945
Width = 660
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 Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim adoRs As Recordset
Set adoRs = New Recordset
' Set adoRs.ActiveConnection = adoCn
adoRs.Open "select * from admin where code='" & Trim(txtUserName.Text) & "'", adoCn, adOpenKeyset, adLockOptimistic
If adoRs.RecordCount <= 0 Then
MsgBox "对不起,没有这个编号的操作员,请重新登陆!"
txtUserName.SetFocus
SendKeys "{Home}+{End}"
adoRs.Close
Exit Sub
End If
'检查正确的密码
If txtPassword = adoRs.Fields("pass").Value Then
UserCode = txtUserName.Text
UserPass = txtPassword.Text
FrmMain.Show
Unload Me
Else
MsgBox "无效的密码，请重试!", , "登录"
txtPassword.SetFocus
SendKeys "{Home}+{End}"
End If
End Sub
Private Sub Form_Load()
On Error GoTo lin:
' InIpath = App.Path + "\Server.ini"
' If Dir(InIpath) = "" Then
' CreateInI "Server", "sa", "", "question"
' End If
' Dim SName As String, Lname As String, PW As String, DatabaseName As String
''读INI
' Dim ServerName As String * 20
' Dim LoginName As String * 20
' Dim Pass As String * 20
' Dim DbName As String * 20
' Dim Result As Long
'
' Result = GetPrivateProfileString("Server", "ServerName", "Server", ServerName, Len(ServerName), InIpath)
' TXTInI = ServerName
' SName = TXTInI
' Result = GetPrivateProfileString("Server", "LoginName", "sa", LoginName, Len(LoginName), InIpath)
' TXTInI = LoginName
' Lname = TXTInI
' Result = GetPrivateProfileString("Server", "Password", "", Pass, Len(Pass), InIpath)
' TXTInI = Pass
' PW = TXTInI
' Result = GetPrivateProfileString("Server", "Database", "question", DbName, Len(DbName), InIpath)
' TXTInI = DbName
' DatabaseName = TXTInI
'
'连接数据库
Set adoCn = New ADODB.Connection
' ConnString = "server=" + SName + ";uid=" + Lname + ";pwd=" + PW + ";database=" + DatabaseName + ";"
' ConnString = "PROVIDER=SQLOLEDB.1;driver={SQL Server};server=hlot-isa;uid=sa;pwd=;database=kaoshi"
' ConnString = "Provider=MSDASQL.1;Persist Security Info=False;Extended Properties=DSN=kaoshi;APP=Visual Basic;WSID=HLOT-ISA;DATABASE=kaoshi;LANGUAGE=简体中文;QueryLog_On=Yes;StatsLog_On=Yes;Trusted_Connection=Yes;Regional=Yes"
ConnString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=kaoshi;Initial Catalog=kaoshi"
adoCn.ConnectionString = ConnString
adoCn.Open
' Dim rlst As String
' MsgBox Getstate(adoCn.State) & vbCr
' Set DB = New Connection
' DB.CursorLocation = adUseClient
' DB.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\question.mdb;Jet OLEDB:"
' 'DB.ConnectionString = ConnString
'DB.Open
Exit Sub
lin:
MsgBox "数据库连接失败，请重新配置服务器连接信息！或者查看SQL Server是否已经启动！"
' frmServerSet.Show
Unload Me
End Sub
Private Sub txtPassword_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = -24145
End Sub
Private Sub txtUserName_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = -24145
End Sub
Public Function Getstate(intState As Integer) As String
Select Case intState
Case adStateClosed
Getstate = "weinengdakai"
Case adStateOpen
Getstate = "lianjie"
End Select
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -