?? frmlogin.frm
字號:
VERSION 5.00
Begin VB.Form frmLogin
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
ClientHeight = 6285
ClientLeft = 45
ClientTop = 330
ClientWidth = 6630
BeginProperty Font
Name = "宋體"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmLogin.frx":0000
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6285
ScaleWidth = 6630
StartUpPosition = 2 '屏幕中心
Begin Manage.Xp_ProgressBar proBar
Height = 255
Left = 1440
TabIndex = 11
Top = 2280
Visible = 0 'False
Width = 4575
_ExtentX = 8070
_ExtentY = 450
End
Begin Manage.xpcmdButton cmdCancel
Cancel = -1 'True
Height = 345
Left = 5460
TabIndex = 8
Top = 5880
Width = 1095
_ExtentX = 1931
_ExtentY = 609
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "關閉(&C)"
ForeColor = -2147483630
End
Begin Manage.xpcmdButton CmdExit
Height = 345
Left = 3360
TabIndex = 7
Top = 2880
Width = 1095
_ExtentX = 1931
_ExtentY = 609
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "退出(&Q)"
ForeColor = -2147483630
End
Begin Manage.xpcmdButton cmdOK
Default = -1 'True
Height = 345
Left = 2160
TabIndex = 6
Top = 2880
Width = 1095
_ExtentX = 1931
_ExtentY = 609
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "登錄(&L)"
ForeColor = -2147483630
End
Begin VB.TextBox txtConceal
BackColor = &H00C0E0FF&
ForeColor = &H00400040&
Height = 300
IMEMode = 3 'DISABLE
Left = 2160
MaxLength = 40
PasswordChar = "*"
TabIndex = 5
Top = 2340
Visible = 0 'False
Width = 2295
End
Begin VB.Timer tmrLoad
Interval = 100
Left = 6240
Top = 0
End
Begin VB.ComboBox cboName
BackColor = &H00C0E0FF&
ForeColor = &H00400040&
Height = 300
ItemData = "frmLogin.frx":000C
Left = 2160
List = "frmLogin.frx":000E
Style = 2 'Dropdown List
TabIndex = 3
Top = 1980
Visible = 0 'False
Width = 2295
End
Begin VB.TextBox txtPassword
BackColor = &H00C0E0FF&
ForeColor = &H00400040&
Height = 300
IMEMode = 3 'DISABLE
Left = 2160
MaxLength = 20
PasswordChar = "*"
TabIndex = 0
TabStop = 0 'False
Top = 2340
Visible = 0 'False
Width = 2175
End
Begin VB.TextBox txtInfo
ForeColor = &H00FF0000&
Height = 4095
Left = 60
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
Top = 1680
Width = 6540
End
Begin VB.Image imgLogo
Height = 735
Left = 5280
Top = 1680
Width = 855
End
Begin VB.Image Image1
Height = 840
Left = 300
Picture = "frmLogin.frx":0010
Top = 1860
Width = 840
End
Begin VB.Label lblClew
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "初次登錄系統,默認用戶名為admin,密碼為空"
ForeColor = &H00FF0000&
Height = 180
Left = 1680
TabIndex = 10
Top = 3360
Width = 3510
End
Begin VB.Image imgMain
Height = 1695
Left = 0
Picture = "frmLogin.frx":0B78
Top = 0
Width = 6660
End
Begin VB.Label lblTitle
AutoSize = -1 'True
BackStyle = 0 'Transparent
ForeColor = &H00C00000&
Height = 180
Left = 1440
TabIndex = 4
Top = 1800
Width = 90
End
Begin VB.Label lblName
AutoSize = -1 'True
BackColor = &H00C0FFFF&
BackStyle = 0 'Transparent
Caption = "用戶名:"
ForeColor = &H00800000&
Height = 180
Left = 1440
TabIndex = 2
Top = 1980
Visible = 0 'False
Width = 630
End
Begin VB.Label lblPassword
AutoSize = -1 'True
BackColor = &H00C0FFFF&
BackStyle = 0 'Transparent
Caption = "密 碼:"
ForeColor = &H00800000&
Height = 180
Left = 1440
TabIndex = 1
Top = 2340
Visible = 0 'False
Width = 630
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 ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '用來延時
'Dim HyperJump '點擊label時產生點擊網頁鏈接的效果，并打開指定的web地址
Dim intCount As Integer
Dim downAddress As String
Dim strPopedom As String
Private Sub cmdCancel_Click()
MDIMain.Enabled = True
Unload Me
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
On Error GoTo loadErr
If Len(txtPassword.Text) = 0 And cboName.Text <> "admin" Then
MsgBox "輸入密碼不能為空!", vbExclamation
txtPassword.SetFocus
Exit Sub
Else
With adoLink
If .State = adStateOpen Then .Close
.Open "select * from 系統管理員 where 用戶名='" & cboName.Text & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
If .EOF = False Then
If Trim(txtPassword.Text) = Trim(.Fields("密碼")) Then
gstrName = Trim(cboName.Text)
gblnPopedom = .Fields("權限")
Unload Me
MDIMain.Show
Else
MsgBox "密碼錯誤,請重新輸入!", vbOKOnly + vbCritical, App.Title
txtPassword.Text = ""
txtConceal.Text = ""
txtConceal.SetFocus
End If
Else
Unload Me
MDIMain.Show
End If
End With
End If
Exit Sub
loadErr:
Call ErrMsg(Err.Number, Err.Description)
End Sub
Private Sub Form_Load()
On Error Resume Next
SaveSetting App.Title, "Settings", "Version", App.Major & "." & App.Minor
cmdOK.Visible = False
cmdExit.Visible = False
imgLogo.Visible = False
imgLogo.Picture = LoadPicture(App.Path & "\pic\logo.gif")
If blnAbout = False Then
Me.Icon = frmTool.Icon
DisSysMenu Me.hwnd, 6
Me.Height = 3120
proBar.Visible = True
proBar.Max = 100
txtInfo.Visible = False
cmdCancel.Visible = False
txtConceal.Enabled = False
frmTool.Hide
lblTitle.Caption = "歡迎使用" & App.Title & "!" & vbCrLf & "正在連接數據庫..."
gstrProvider = frmTool.cboProvider.Text
gstrDatabaseName = frmTool.txtDatabase.Text
gblnPS = Not (CBool(frmTool.chkPass.Value))
If gblnPS = True Then
gstrDataUser = frmTool.txtName.Text
gstrPassword = frmTool.txtPassword.Text
End If
tmrLoad.Enabled = True
Else
Dim strTemp As String
Dim File_Num As Long
On Error GoTo errNext
File_Num = FreeFile
Open App.Path & "\about.txt" For Binary As #File_Num
strTemp = Input$(LOF(File_Num), #File_Num)
Close #File_Num
Me.Icon = MDIMain.Icon
tmrLoad.Enabled = False
lblTitle.Visible = False
cboName.Enabled = False
txtConceal.Enabled = False
Me.Caption = "關于..."
If gblnPopedom = 1 Then strPopedom = "高級" Else strPopedom = "普通"
txtInfo.Text = strTemp & vbCrLf & " 感謝" & gstrCro & "對本軟件的支持!" & vbCrLf & vbCrLf & _
"[用戶信息]" & vbCrLf & vbCrLf & " 使用單位: " & gstrCro & vbCrLf & _
" 管理員IP: " & LinkIP & vbCrLf & " 管理級別: " & strPopedom & vbCrLf & " 當前管理員:" & gstrName
strTemp = ""
Exit Sub
errNext:
strTemp = ""
Call ErrMsg(Err.Number, Err.Description)
End If
End Sub
Private Sub loadUser()
On Error GoTo loadErr
With adoLink
intCount = 0
Do Until .EOF
cboName.AddItem .Fields("用戶名"), intCount
.MoveNext
intCount = intCount + 1
Loop
If intCount = 0 Then cboName.AddItem "admin", 0
End With
Exit Sub
loadErr:
Call ErrMsg(Err.Number, Err.Description)
End Sub
Private Sub txtConceal_Change()
Dim D As String, e As String, C As Integer
D = " abcdefghijklmnopqrstuvwxyz"
txtPassword.SetFocus
C = Len((txtPassword.Text))
e = Mid(D, C + 1, 1) & (C + 1)
txtConceal.Text = Mid(txtConceal.Text & e, 1, C * 2)
txtConceal.SetFocus
SendKeys "{end}"
End Sub
Private Sub txtConceal_KeyPress(KeyAscii As Integer)
If KeyAscii = 8 Then
If Len(txtPassword.Text) = 0 Then Exit Sub
txtPassword.Text = Mid(txtPassword.Text, 1, Len(txtPassword.Text) - 1)
Else
txtPassword.Text = txtPassword.Text & Chr(KeyAscii)
End If
End Sub
Private Sub txtPassword_GotFocus()
txtConceal.SetFocus
SendKeys "{end}"
End Sub
Private Sub tmrLoad_Timer()
tmrLoad.Enabled = False
Me.Refresh
proBar.Value = 100
Me.Refresh
DoEvents
Call loadOver
End Sub
Sub loadOver()
On Error GoTo ErrLink
gstrLink = gstrNowLink
If Len(gstrLink) = 0 Then gblnLoadError = True: GoTo EndTimer
With adoConn
.CursorLocation = adUseClient
.Open gstrLink
End With
With adoLink
If .State = adStateOpen Then .Close
.Open "select * from 公司信息", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
If .EOF = False Then
gstrCro = .Fields("公司名稱") & ""
gstrCroLogo = .Fields("商標") & ""
End If
.Close
.Open "select id from 員工詳細資料", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
If .EOF = False Then
.MoveLast
gintManCount = .RecordCount
.MoveFirst
End If
.Close
.Open "select * from 隸屬部門", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
If .EOF = False Then
.MoveLast
gintManageCount = .RecordCount
.MoveFirst
End If
.Close
.Open "select * from 系統管理員 order by 用戶名", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
End With
EndTimer:
If gblnLoadError = False Then
Me.Hide
imgLogo.Visible = True
proBar.Visible = False
lblTitle.Visible = False
lblName.Visible = True
lblPassword.Visible = True
txtConceal.Visible = True
txtPassword.Visible = True
cmdOK.Visible = True
cmdExit.Visible = True
Me.Height = 4000
Me.Caption = App.Title & " Ver " & App.Major & "." & App.Minor
txtConceal.Enabled = True
Call loadUser
cboName.Visible = True
Me.Show
If cboName.ListCount > 0 Then cboName.ListIndex = 0
txtPassword.SetFocus
Unload frmTool
Else
frmTool.Show
Unload Me
End If
Exit Sub
ErrLink:
gblnLoadError = True
Call ErrMsg(Err.Number, Err.Description & vbCrLf & vbCrLf & vbTab & " 請設置數據庫連接或與網絡管理員聯系!")
GoTo EndTimer
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -