?? dlgusermanager.frm
字號(hào):
VERSION 5.00
Begin VB.Form dlgUserManager
BorderStyle = 3 'Fixed Dialog
Caption = "系統(tǒng)用戶設(shè)置"
ClientHeight = 2115
ClientLeft = 45
ClientTop = 330
ClientWidth = 4560
Icon = "dlgUserManager.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2115
ScaleWidth = 4560
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 375
Left = 3360
TabIndex = 5
Top = 1620
Width = 975
End
Begin VB.Frame fra1
Height = 495
Left = 1320
TabIndex = 6
Top = 960
Width = 3015
Begin VB.OptionButton opt1
Caption = "系統(tǒng)管理員"
Height = 180
Left = 240
TabIndex = 2
Top = 210
Value = -1 'True
Width = 1215
End
Begin VB.OptionButton opt2
Caption = "普通用戶"
Height = 180
Left = 1680
TabIndex = 3
Top = 210
Width = 1215
End
End
Begin VB.CommandButton cmdOK
Caption = "確定(&O)"
Height = 375
Left = 2400
TabIndex = 4
Top = 1620
Width = 975
End
Begin VB.TextBox txtName
Height = 270
Left = 1320
TabIndex = 1
Top = 600
Width = 3015
End
Begin VB.TextBox txtCode
Enabled = 0 'False
Height = 270
Left = 1320
TabIndex = 0
Top = 120
Width = 3015
End
Begin VB.Label lblInfo
Caption = "用戶職位:"
Height = 195
Index = 2
Left = 240
TabIndex = 9
Top = 1125
Width = 975
End
Begin VB.Label lblInfo
Caption = "用戶姓名:"
Height = 195
Index = 1
Left = 240
TabIndex = 8
Top = 645
Width = 975
End
Begin VB.Label lblInfo
Caption = "用戶編號(hào):"
Height = 195
Index = 0
Left = 240
TabIndex = 7
Top = 165
Width = 975
End
End
Attribute VB_Name = "dlgUserManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m_tagErrInfo As TYPE_ERRORINFO
Dim m_iCode As Integer
Dim m_sCode As String
Dim m_bChange As Boolean
Private Sub cmdCancel_Click()
On Error Resume Next
Unload Me
End Sub
Private Sub cmdOK_Click()
On Error GoTo ERROR_EXIT
Dim iTrans As Integer, i As Integer
If Trim$(txtCode.Text) = "" Then
MsgBox "請(qǐng)輸入正確的用戶工號(hào)!", vbOKOnly, "系統(tǒng)提示"
Exit Sub
End If
If Trim$(txtName.Text) = "" Then
MsgBox "請(qǐng)輸入正確的用戶姓名!", vbOKOnly, "系統(tǒng)提示"
Exit Sub
End If
If opt1.Value = True Then
i = 0
Else
i = 1
End If
'修改數(shù)據(jù)庫(kù)
iTrans = dbMyDB.BeginTrans
If m_bChange = False Then
dbMyDB.Execute "INSERT INTO QFUser([ku_name],[department_id],[emp_code],[admin_flag],[ku_password])" _
& "VALUES( '" & txtName.Text & "', NULL, '" & txtCode.Text & "', '" & i & "', ' ')"
Else
dbMyDB.Execute "UPDATE QFUser SET ku_name = '" & txtName.Text & "', admin_flag = '" & i & "', " & _
"emp_code = '" & txtCode.Text & "' WHERE ku_id = '" & m_iCode & "'"
End If
If iTrans > 0 Then
dbMyDB.CommitTrans
iTrans = 0
End If
Unload Me
Exit Sub
ERROR_EXIT:
If iTrans > 0 Then dbMyDB.RollbackTrans
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "dlgUserManager"
m_tagErrInfo.strErrFunc = "cmdOK_Click"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
End Sub
Private Sub Form_Load()
On Error GoTo ERROR_EXIT
Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
Dim strSQL As String, i As Integer
m_bChange = False
'連接數(shù)據(jù)庫(kù)
cmd.ActiveConnection = dbMyDB
cmd.CommandType = adCmdText
'查詢數(shù)據(jù)庫(kù)
strSQL = "SELECT TOP 1 * FROM QFUser ORDER BY ku_id DESC"
cmd.CommandText = strSQL
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenStatic, adLockReadOnly
If Not rs.EOF And rs.RecordCount > 0 Then
rs.MoveFirst
If Not IsNumeric(rs!emp_code) Then
m_sCode = CStr(rs!ku_id)
Else
i = CInt(rs!emp_code) + 1
m_sCode = CStr(i)
End If
Else
m_sCode = "1"
End If
rs.Close
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
Set cmd = Nothing
Exit Sub
ERROR_EXIT:
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "dlgUserManager"
m_tagErrInfo.strErrFunc = "Form_Load"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
End Sub
Private Sub Form_Terminate()
On Error Resume Next
Set dlgUserManager = Nothing
End Sub
Private Sub txtCode_GotFocus()
On Error Resume Next
txtCode.BackColor = &H80000018
End Sub
Private Sub txtCode_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then '是回車鍵?
KeyAscii = 0 '0取消輸入
SendKeys "{tab}"
End If
End Sub
Private Sub txtCode_LostFocus()
On Error Resume Next
txtCode.BackColor = &H80000005
End Sub
Private Sub txtName_GotFocus()
On Error Resume Next
txtName.BackColor = &H80000018
End Sub
Private Sub txtName_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then '是回車鍵?
KeyAscii = 0 '0取消輸入
SendKeys "{tab}"
End If
End Sub
Private Sub txtName_LostFocus()
On Error Resume Next
txtName.BackColor = &H80000005
End Sub
'//////////////////////////////////////////////////////////////////////////////////////////
'/設(shè)定服務(wù)編號(hào)
Public Property Let UserCode(ByVal vNewValue As Integer)
On Error Resume Next
m_iCode = vNewValue
m_bChange = True
End Property
'初始化對(duì)話框
Public Function InitSet() As Boolean
On Error GoTo ERROR_EXIT
Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
Dim strSQL As String, i As Integer
If m_bChange = False Then
txtCode.Text = m_sCode
Else
'連接數(shù)據(jù)庫(kù)
cmd.ActiveConnection = dbMyDB
cmd.CommandType = adCmdText
'查詢數(shù)據(jù)庫(kù)
strSQL = "SELECT * FROM QFUser WHERE ku_id = '" & m_iCode & "'"
cmd.CommandText = strSQL
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenStatic, adLockReadOnly
If Not rs.EOF And rs.RecordCount > 0 Then
If Not IsNull(rs!emp_code) Then txtCode.Text = rs!emp_code
If Not IsNull(rs!ku_name) Then txtName.Text = rs!ku_name
If Not IsNull(rs!admin_flag) Then
If rs!admin_flag = 0 Then
opt1.Value = True
Else
opt2.Value = True
End If
End If
Else
GoTo ERROR_EXIT
End If
rs.Close
End If
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
Set cmd = Nothing
InitSet = True
Exit Function
ERROR_EXIT:
m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
m_tagErrInfo.strErrFile = "dlgUserManager"
m_tagErrInfo.strErrFunc = "InitSet"
m_tagErrInfo.nErrNum = Err.Number
m_tagErrInfo.strErrDesc = Error(Err.Number)
If Err.Number <> 0 Then Err.Clear
modErrorInfo.WriteErrLog m_tagErrInfo
End Function
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -