?? frmaskuser.frm
字號:
VERSION 5.00
Begin VB.Form frmAskUser
BorderStyle = 3 'Fixed Dialog
Caption = "用戶注冊"
ClientHeight = 1635
ClientLeft = 45
ClientTop = 330
ClientWidth = 5085
Icon = "frmAskUser.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1635
ScaleWidth = 5085
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdOK
Caption = "確定(O)"
Default = -1 'True
Height = 375
Left = 1320
TabIndex = 2
Top = 1080
Width = 1335
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 375
Left = 3000
TabIndex = 3
Top = 1080
Width = 1335
End
Begin VB.TextBox txtUID
Height = 270
Left = 2160
TabIndex = 0
Top = 240
Width = 2535
End
Begin VB.TextBox txtPWD
Height = 270
IMEMode = 3 'DISABLE
Left = 2160
PasswordChar = "*"
TabIndex = 1
Top = 600
Width = 2535
End
Begin VB.Image Image1
Height = 480
Left = 360
Picture = "frmAskUser.frx":058A
Top = 240
Width = 480
End
Begin VB.Label Label2
Caption = "口令:"
Height = 255
Left = 1200
TabIndex = 5
Top = 600
Width = 975
End
Begin VB.Label Label1
Caption = "用戶名:"
Height = 255
Left = 1200
TabIndex = 4
Top = 240
Width = 975
End
End
Attribute VB_Name = "frmAskUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'INI變量
Public g_Password As String
Public g_Database As String
Public g_DSN As String
Public g_UID As String
Public g_PWD As String
Public g_Server As String
Public g_Driver As String
Public g_DataSourceType As String
Public g_Check As Integer
'系統(tǒng)用戶
Public gValidUser As Boolean '是否為合法用戶
Public gUserCount As Integer '當前用戶數(shù)
Private Sub cmdCancel_Click()
g_Database = ""
gValidUser = False
gCurUser = ""
Unload Me
' End
End Sub
Private Sub cmdOK_Click()
Dim temUID As String
Dim temPWD As String
Dim sErr As String
temUID = txtUID.Text
temPWD = txtPWD.Text
If CheckValidUser(temUID, temPWD, sErr) Then
gCurUser = temUID
gCurUserPWD = temPWD
gValidUser = True
Unload Me
Else
MsgBox sErr, vbOKOnly, Me.Caption
If txtUID.Enabled Then txtUID.SetFocus
End If
End Sub
Private Sub txtPWD_GotFocus()
With txtPWD
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Private Sub txtUID_GotFocus()
With txtUID
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Function CheckValidUser(ByRef vUID As String, ByRef vPWD As String, ByRef vErr As String) As Boolean
Dim rcUsers As ADODB.Recordset
Dim strSQL As String
Dim temPWD As String
Dim temRole As String
Dim aRole() As String
'----------------------------------------------------------------
CheckValidUser = False
vErr = ""
gRInput = False
gRQuery = False
gRAdmin = False
gRExt = False
'----------------------------------------------------------------
strSQL = "SELECT * FROM SYS_Users WHERE " _
& gSQL_UPPER & "(UID)='" _
& UCase(Trim(vUID)) & "' "
Set rcUsers = New ADODB.Recordset
On Error GoTo err_OpenUsers
rcUsers.Open strSQL, SYS_Cnn, adOpenDynamic, adLockOptimistic, adCmdText
On Error GoTo 0
temPWD = ""
temRole = ""
If rcUsers.EOF Then vErr = "用戶名或口令錯誤!"
Do Until rcUsers.EOF
If Not IsNull(rcUsers!PWD) Then
temPWD = Trim(rcUsers!PWD)
End If
DisPack temPWD
If temPWD <> vPWD Then
vErr = "用戶名或口令錯誤!"
Else
If Not IsNull(rcUsers!Role) Then
temRole = Trim(rcUsers!Role)
End If
aRole = Split(temRole, ",")
For I = 0 To UBound(aRole)
If aRole(I) = USER_INPUT Then
gRInput = True
CheckValidUser = True
End If
If aRole(I) = USER_QUERY Then
gRQuery = True
CheckValidUser = True
End If
If aRole(I) = USER_ADMIN Then
gRAdmin = True
CheckValidUser = True
End If
If aRole(I) = USER_EXT Then
gRExt = True
CheckValidUser = True
End If
Next I
If CheckValidUser Then Exit Do
vErr = "沒有足夠的權(quán)限!"
End If
rcUsers.MoveNext
Loop
Exit Function
err_OpenUsers:
ShowError "無法打開系統(tǒng)用戶表", ERR_SHOW_OK
Exit Function
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -