www.pudn.com > kelon.rar > fLogin.frm
VERSION 5.00
Begin VB.Form fLogin
BorderStyle = 1 'Fixed Single
Caption = "登录对话框 V1.01"
ClientHeight = 2100
ClientLeft = 45
ClientTop = 330
ClientWidth = 4185
Icon = "fLogin.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2100
ScaleWidth = 4185
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command2
Caption = "关闭"
Height = 360
Left = 3150
TabIndex = 6
Top = 720
Width = 915
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 360
Left = 3150
TabIndex = 5
Top = 270
Width = 915
End
Begin VB.TextBox Text3
Alignment = 2 'Center
BackColor = &H8000000F&
BorderStyle = 0 'None
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 465
Left = 180
MultiLine = -1 'True
TabIndex = 4
TabStop = 0 'False
Text = "fLogin.frx":030A
Top = 1500
Width = 3660
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1095
MaxLength = 20
TabIndex = 0
Top = 285
Width = 1740
End
Begin VB.TextBox Text2
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
IMEMode = 3 'DISABLE
Left = 1095
MaxLength = 20
PasswordChar = "*"
TabIndex = 2
Top = 705
Width = 1740
End
Begin VB.Line Line2
BorderColor = &H00E0E0E0&
X1 = -495
X2 = 4170
Y1 = 1380
Y2 = 1380
End
Begin VB.Line Line1
BorderColor = &H00404040&
BorderWidth = 2
X1 = -285
X2 = 4170
Y1 = 1395
Y2 = 1395
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "口令："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 510
TabIndex = 3
Top = 765
Width = 630
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "工号："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 0
Left = 510
TabIndex = 1
Top = 375
Width = 630
End
End
Attribute VB_Name = "fLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private nrs As New ADODB.Recordset
Private Const WAITMSG = "您好，请输入正确的工号和口令，谢谢"
Private Const UPTAB = 47 '"/"上移键
Private Const ENTER = 13 '
Private Const HELP1 = 63 '
Private MTRY As Integer '重试次数
Private LoginSucceeded As Long '标志是否登录成功
Private mUserName As String '用户名
Private mPassWord As String '口令
Private Text_Loca As Long '录入的焦点位置
Private Sub Command1_Click()
Call pubFunction(0) '确定
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
'分析按键
Private Sub Form_KeyPress(KeyAscii As Integer)
Text3 = WAITMSG '初始提示
If KeyAscii = 8 Then Exit Sub
If KeyAscii = HELP1 Then '帮助
MsgBox "“/”：TAB键" + Chr(10) + Chr(13) + " “0”：退出", 48, "帮助"
KeyAscii = 0
Exit Sub
End If
If KeyAscii = UPTAB Then '当位置在2时，按上移键有效
SendKeys "{TAB}"
KeyAscii = 0 '清除键位
' Text1.SetFocus '位置1得到焦点
Exit Sub '结束按键过程
End If
'回车当在位置1时是确定、当在位置2时为下移，当1，2位置为0时退出,当2为空时，回到1
If KeyAscii = ENTER Then
KeyAscii = 0 '清除键位
If Text1 = "0" Or Text2 = "0" Then
Unload Me '退出
Exit Sub '结束按键过程
End If
If Text_Loca = 1 Then
Text2.SetFocus '位置2得到焦点
Exit Sub '结束按键过程
End If
If Text_Loca = 2 Then
If Text2 = "" Then '当口令为空是无效，退回到1位
Text1.SetFocus
Else
Call pubFunction(0) '确定
End If
' Text2 = ""
Exit Sub '结束按键过程
End If
End If
'按键不为0-9时为忽略
' If Asc("0") > KeyAscii Or Asc("9") < KeyAscii Then
' KeyAscii = 0
' Exit Sub '结束按键过程
' End If
End Sub
Private Sub Form_Load()
'// 只运行一次
If App.PrevInstance Then
' MsgBox ("注意：程序已经运行，不能再次装载。"), vbExclamation
End
End If
Text3 = WAITMSG '初始提示
Call mlogin.GetIniFileName
Text1.Text = mlogin.pGetString(localFn, "local", "LastID") '取上次正确登录的用户名称
End Sub
'窗口有效时，设置焦点位置
Private Sub Form_Activate()
If Len(Text1) > 0 Then
Text2.SetFocus
Else
Text1.SetFocus
End If
End Sub
Private Sub Text1_GotFocus()
Text_Loca = 1 '只要在输入用户名称时，口令域为空
Text2 = ""
SendKeys "{Home}+{End}" '全选位置
End Sub
Private Sub Text1_LostFocus()
If Trim(Text1) = "" Then Text1 = "8001" '缺省用户
End Sub
Private Sub Text2_GotFocus()
Text_Loca = 2
SendKeys "{Home}+{End}" '全选位置
End Sub
'确定键按下后
Private Sub pubFunction(ByVal Index As Integer)
Dim pwsin As String
Dim pws As String
pws = pGetPws
pwsin = mlogin.Text2MM(Text2.Text + Text1.Text)
If pwsin = pws Then
Call mlogin.WritePrivateProfileString("local", "LastID", Text1.Text, localFn)
' MsgBox "OK"
Shell App.Path + "\KL_Show.exe 0," & Text1.Text & ",wyzshxl", vbNormalFocus
Unload Me
Exit Sub
Else
MsgBox "请核对用户名和密码.", 32, "提示"
Text1.SetFocus
End If
End Sub
Private Function pGetPws() As String
Call mlogin.OpenODBC(Cn_Des, "ConnectionString001")
Dim sSql As String
sSql = pGetString(localFn, "SQLstr", "Select00")
sSql = "SELECT " & sSql
sSql = Replace(sSql, "@1@", Text1.Text)
nrs.Open sSql, Cn_Des, , , adCmdText
On Error GoTo err
pGetPws = nrs.Fields(0).Value
Exit Function
nrs.Close
err:
On Error GoTo 0
pGetPws = ""
nrs.Close
Cn_Des.Close
End Function
'-----------------------------------------------------------------