frmuser.frm

考勤机管理软件,用于统计某段时间某个部门或者某个员工在某段内迟到与早退次数.

      HAND            =   0   'False
      CHECK           =   0   'False
      VALUE           =   0   'False
   End
End
Attribute VB_Name = "frmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rstGrid As New ADODB.Recordset
Dim rstExec As New ADODB.Recordset

Dim m_Edit As Boolean
Dim m_LoginID As Integer
Dim m_Password As String

Dim Ie As New SINOURATLLib.CsEncrypt


Private Sub cmdAdd_Click()
    If Trim(UserName) <> "Admin" Then
        Message "你没有新增的权限!"
        Exit Sub
    End If
        
    txtName.Enabled = True
    txtPwd1.Enabled = False
    txtPwd2.Enabled = True
    txtPwd3.Enabled = True
    
    txtName.Text = ""
    txtPwd1.Text = ""
    txtPwd2.Text = ""
    txtPwd3.Text = ""
    
    txtName.SetFocus
    m_Edit = False
    
End Sub

Private Sub cmdDel_Click()
'    rstGrid.Requery
'    Grid.ReFetch
'    MsgBox rstGrid.RecordCount
    If Trim(UserName) <> "Admin" Then
        Message "你没有删除的权限!"
        Exit Sub
    End If
    
    If Trim(rstGrid.Fields("Name")) = "Admin" Then
        Message "管理员帐号不能删除!"
        Exit Sub
    End If
    If MsgBox("确定删除?", vbInformation + vbYesNo, "询问") = vbNo Then
        Exit Sub
    End If
    Grid.Delete
    AllClose
End Sub

Private Sub cmdEdit_Click()

    If Grid.RecordCount = 0 Then
        Message "没有可用信息!"
        Exit Sub
    End If
    
    If Grid.CurRow = -1 Then
        Message "请先选中用户!"
        Exit Sub
    End If
    
    txtName.Enabled = True
    txtPwd1.Enabled = True
    txtPwd2.Enabled = True
    txtPwd3.Enabled = True
    
    txtName.Text = rstGrid.Fields("Name")
    If Trim(rstGrid.Fields("name")) = "Admin" Then txtName.Enabled = False
    
    txtPwd1.Text = ""
    txtPwd2.Text = ""
    txtPwd3.Text = ""
    
    m_Edit = True
    If IsNull(rstGrid.Fields("Password")) Then m_Password = "" Else m_Password = Trim(rstGrid.Fields("Password"))
    m_LoginID = rstGrid.Fields("LoginID")
    
    txtPwd1.SetFocus
End Sub

Private Sub cmdSave_Click()
Dim sPwd As String
    
    If Trim(txtName.Text) = "" Then
        Message "请输入用户名!"
        Exit Sub
    End If
    If Trim(txtPwd2.Text) <> Trim(txtPwd3.Text) Then
        Message "两次密码不一致!"
        Exit Sub
    End If

    Dim strSQL As String
    If m_Edit = False Then
        
        If rstExec.State = 1 Then rstExec.Close
        Set rstExec = Nothing
        rstExec.CursorLocation = adUseClient
        rstExec.Open "select * from login where name='" & txtName.Text & "'", con, adOpenStatic, adLockBatchOptimistic
        If rstExec.RecordCount > 0 Then
            Message "该用户名已存在!"
            Exit Sub
        End If
        
        rstExec.AddNew
        rstExec.Fields("Name") = Trim(txtName.Text)
        rstExec.UpdateBatch
        
        If rstExec.State = 1 Then rstExec.Close
        Set rstExec = Nothing
        rstExec.CursorLocation = adUseClient
        rstExec.Open "select top 1 * from login where name='" & txtName.Text & "'", con, adOpenStatic, adLockBatchOptimistic
        If rstExec.RecordCount > 0 Then
            m_LoginID = rstExec.Fields("LoginID")
        Else
             Message "记录未找到!"
            Exit Sub
        End If

        m_LoginID = rstExec.Fields("LoginID")
        sPwd = Ie.DoEncrypt(CStr(m_LoginID) & Trim(txtPwd2.Text))
        
        rstExec.Fields("Password") = sPwd
        rstExec.UpdateBatch
        
'        strSQL = "insert into login(Name,Password) values('" & Trim(txtName.Text) & "','" & Trim(txtPwd2.Text) & "')"
'        con.Execute strSQL
        
        rstGrid.Requery
        Grid.ReFetch
        
        Call cmdAdd_Click
        
    Else
        
        sPwd = Ie.DoEncrypt(CStr(m_LoginID) & Trim(txtPwd1.Text))
        If sPwd <> m_Password Then
            Message "原始密码不正确!"
            Exit Sub
        End If
        
        If rstExec.State = 1 Then rstExec.Close
        Set rstExec = Nothing
        rstExec.CursorLocation = adUseClient
        rstExec.Open "select * from login where LoginID=" & m_LoginID, con, adOpenStatic, adLockBatchOptimistic
        
        If rstExec.RecordCount < 1 Then
            Message "记录未找到!"
            Exit Sub
        End If
        
        sPwd = Ie.DoEncrypt(CStr(m_LoginID) & Trim(txtPwd2.Text))
        rstExec.Fields("Name") = Trim(txtName.Text)
        rstExec.Fields("Password") = sPwd
        rstExec.UpdateBatch
        
'        strSQL = "update login1 set name1='" & Trim(txtName.Text) & "' ,password1='" & Trim(txtPwd2.Text) & "' where LoginID=" & m_LoginID
'        Debug.Print strSQL
'        con.Execute strSQL
        
        rstGrid.Requery
        Grid.ReFetch
        AllClose
        
        Message "更改成功!"
    End If
        
End Sub

Private Sub Form_Load()
    Me.Icon = MDI.Icon
    Me.Caption = "用户管理"
    
    Ie.SetTable "121212414321324"


    rstGrid.Open "select * from login", con, adOpenStatic, adLockOptimistic
    
    Grid.AddHeader "序号", "Serial", 30, -1, "Serial", False, sSerial
    Grid.AddHeader "用户名", "Name", 120, -1, "Name", False, sDefault
    Grid.AllowAddNew = False
    Grid.ColAutoResize = True
    Set Grid.DataSource = rstGrid
    
    
    AllClose
    
End Sub


Sub AllClose()
    txtName.Text = ""
    txtPwd1.Text = ""
    txtPwd2.Text = ""
    txtPwd3.Text = ""

    txtName.Enabled = False
    txtPwd1.Enabled = False
    txtPwd2.Enabled = False
    txtPwd3.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)

    If rstGrid.State = 1 Then rstGrid.Close
    Set rstGrid = Nothing
    
End Sub

Private Sub sButton1_Click()
    
End Sub

Private Sub Grid_Click()
    If Grid.RecordCount = 0 Then
        Message "没有可用信息!"
        Exit Sub
    End If
    
    If Grid.CurRow = -1 Then
        Message "请先选中用户!"
        Exit Sub
    End If
    
    txtName.Enabled = False
    txtPwd1.Enabled = False
    txtPwd2.Enabled = False
    txtPwd3.Enabled = False
    
    txtName.Text = rstGrid.Fields("Name")
    
    txtPwd1.Text = ""
    txtPwd2.Text = ""
    txtPwd3.Text = ""
    
    

End Sub

Private Sub txtName_ArrowKey(ByVal KeyCode As STEXTBOXLib.m_ArrowKey)
    If KeyCode = sEnter Then
        If m_Edit = False Then txtPwd2.SetFocus
        If m_Edit = True Then txtPwd1.SetFocus
    End If
End Sub

Private Sub txtPwd1_ArrowKey(ByVal KeyCode As STEXTBOXLib.m_ArrowKey)
    If KeyCode = sEnter Then txtPwd2.SetFocus
End Sub

Private Sub txtPwd2_ArrowKey(ByVal KeyCode As STEXTBOXLib.m_ArrowKey)
    If KeyCode = sEnter Then txtPwd3.SetFocus
End Sub