📄 frmlogin.frm
字号:
VERSION 5.00
Begin VB.Form frmLogin
BackColor = &H00D39E9F&
BorderStyle = 1 'Fixed Single
Caption = "612"
ClientHeight = 2670
ClientLeft = 2835
ClientTop = 3495
ClientWidth = 5130
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1577.523
ScaleMode = 0 'User
ScaleWidth = 4816.792
StartUpPosition = 2 '屏幕中心
Begin VB.ComboBox username
Height = 300
ItemData = "frmLogin.frx":0000
Left = 1800
List = "frmLogin.frx":0002
Style = 2 'Dropdown List
TabIndex = 0
Top = 390
Width = 2325
End
Begin VB.CommandButton cmdOK
Caption = "17"
Default = -1 'True
Height = 360
Left = 780
TabIndex = 2
Top = 1620
Width = 1545
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "18"
Height = 360
Left = 2610
TabIndex = 3
Top = 1620
Width = 1545
End
Begin VB.TextBox txtPassword
Height = 345
IMEMode = 3 'DISABLE
Left = 1800
PasswordChar = "*"
TabIndex = 1
Top = 915
Width = 2325
End
Begin VB.Label lblLabels
BackStyle = 0 'Transparent
Caption = "64"
Height = 270
Index = 0
Left = 795
TabIndex = 4
Top = 420
Width = 960
End
Begin VB.Label lblLabels
BackStyle = 0 'Transparent
Caption = "611"
Height = 270
Index = 1
Left = 795
TabIndex = 5
Top = 930
Width = 1080
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 rs As ADODB.Recordset
Public LoginSucceeded As Boolean
Private str As String
Private f As Integer
Private Sub CmdCancel_Click()
'设置全局变量为 false
'不提示失败的登录
LoginSucceeded = False
'Unload FrmFLash
End
End Sub
Private Sub CmdOk_Click()
'检查正确的密码
's$ = "000000000000000000"
'On Error GoTo Err_CmdOK_CLick
Dim i As Integer
LoginSucceeded = False
If username.Text = "" Then
username.SetFocus
SendKeys "{Home}+{End}"
MisMsg "无效的用户名或密码,请重试!"
Exit Sub
End If
Set rs = New Recordset
rs.Open "SELECT UserID, PassWord FROM PubOAUSer where UserID='" & Trim(Me.username) & "' ", GetCNClient, adOpenStatic, adLockReadOnly
If rs.EOF And rs.BOF Then
MisMsg "未找到此用户?"
Else
str = IIf(IsNull(rs![Password]), "", rs![Password])
If Trim(str) = Trim(txtPassword.Text) Then
LoginSucceeded = True
Else
f = f + 1
MisMsg "第 " & f & " 密码错误?"
If f = 3 Then
End
End If
End If
Me.txtPassword.SelStart = 0
Me.txtPassword.SelLength = Len(Me.txtPassword.Text)
End If
rs.Close
If f < 3 Then
If LoginSucceeded Then
Set rs = New Recordset
GetCNClient.Close
DoEvents
'MsgBox GetCNClient
rs.Open "SELECT LoginName, ComputerName, BeginTime, UpdateTime FROM OAOnlineUser Where loginname='" & Me.username.Text & "' and ComputerName='" & LocalComputerName & "' ;", GetCNClient, adOpenStatic, adLockOptimistic
If rs.EOF Then
rs.AddNew
rs![LoginName] = Me.username.Text
rs![ComputerName] = LocalComputerName
rs![BeginTime] = Format(Date, "yyyy-mm-dd") & Format(Time, " hh:mm:ss")
rs![UpdateTime] = Format(Date, "yyyy-mm-dd") & Format(Time, " hh:mm:ss")
rs.Update
'Else
' MisMsg "已在同一计算机上已打开该程序。"
' Exit Sub
End If
LoginName = Me.username.Text
Unload Me
DoEvents
Unload pub_Splash
If DataTranns("Inventory", "Inventory_ID") = 1 Then
MisMsg "Inventory 同步出错,请重新启动程序!"
Exit Sub
End If
If DataTranns("Mis_Size", "Size_Type", "ID") = 1 Then
MisMsg "Mis_Size 同步出错,请重新启动程序!"
Exit Sub
End If
If DataTranns("Mis_Size_Type", "ID") = 1 Then
MisMsg "Mis_Size_Type 同步出错,请重新启动程序!"
Exit Sub
End If
If GIsBeginUse Then
PubOAMain.Show
Else
FrmPubInitData.Show
End If
End If
Else
MisMsg "登录失败。"
Unload Me
End If
Exit Sub
Err_CmdOK_CLick:
'End If
MisMsg "Err_CmdOK_CLick Error:" & Err.Description
Exit Sub
End Sub
Private Sub Form_Load()
On Error GoTo Err_FormLoad
Dim i As Integer
Me.Caption = LoadResString(Val(Me.Caption & GLanguageID))
GGetRes GLanguageID, Me
Set rs = New Recordset
rs.Open "select UserId from PubOAUser Order by UserID", GetCNClient(), adOpenStatic, adLockReadOnly
Do Until rs.EOF
Me.username.AddItem rs![UserID]
rs.MoveNext
Loop
rs.Close
Exit Sub
Err_FormLoad:
MisMsg "Form_Load Error:" & Err.Description
Exit Sub
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -