frmsys.frm

能够录入人事的基本资料

    LbChange.Enabled = False
    LbFire.Enabled = False

End Sub

Public Sub ActiveAll()

    LsLimt.Enabled = True
    LsUser.Enabled = True
    cmdOK.Enabled = True
    CmdCancel.Enabled = True
    Label9.Enabled = True
    Label10.Enabled = True
    LbAdduser.Enabled = True
    LbChange.Enabled = True
    LbFire.Enabled = True

End Sub

Private Sub CmdCCancel_Click()

    TxtC1.Text = TxtC2.Text = ""
    Frame2.Visible = False
    Call ActiveAll
    
End Sub

Private Sub CmdCOK_Click()

    If TxtC1.Text = TxtC2.Text Then
 
        For i = 1 To Usercount - 1
            If LsUser.Text = user(i) Then
                pws(i) = TxtC1.Text
            End If
        Next i

    End If
    
    Frame2.Visible = False
    Call ActiveAll
 
End Sub

Private Sub CmdNewCancel_Click()
    
    Frame1.Visible = False
    Call ActiveAll
    FrmSys.SetFocus
 
End Sub

Private Sub Form_Load()

    DataA.DatabaseName = App.Path + "\sm.mdb"
    DataB.DatabaseName = App.Path + "\sm.mdb"

    DataA.RecordSource = "select * from employee"
    DataA.Refresh

    DataB.RecordSource = "select * from user"
    DataB.Refresh

    If Dir(App.Path + "\user.ini") = "" Then
           MsgBox "文件不存在。"
    Else
           fil = FreeFile()
        Open App.Path + "\user.ini" For Input As #fil
    
           i = 0
           Do While Not EOF(fil)
                Input #fil, user(i), pws(i)
                Input #fil, state(i), Emplo(i)
                i = i + 1
           Loop
            
           Usercount = i  '用户数目
               
          Close #fil
         
         For i = 0 To Usercount - 1
            If state(i) = "A" Then
                    LsUser.AddItem user(i)
            ElseIf state(i) = "L" Then
                    LsLimt.AddItem user(i)
            End If
         Next i
        
    End If
    
End Sub

Private Sub CmdCancel_Click()

    Me.Hide
    FrmMain.Enabled = True
    FrmMain.SetFocus

End Sub

Private Sub cmdOK_Click()

    fil = FreeFile()
       
    Open App.Path + "\user.ini" For Output As #fil
    
    For i = 0 To Usercount - 1
         Print #fil, user(i); ","; pws(i); ","; state(i); ","; Emplo(i)
              
    Next i
   
         Close #fil

    Me.Hide
    FrmMain.SetFocus
    
End Sub

Private Sub CmNewOK_Click()
    
    If Txtnew.Text = "" Or TxtName.Text = "" Then
        MsgBox "请输入名字和职工号"
        Txtnew.SetFocus
        Exit Sub
        
    End If
        
    
    For i = 1 To Usercount - 1         '判断是否此职员已经是用户
        If Emplo(i) = Txtnew.Text Then '如果已经存在且非F状态则
            MsgBox ("本用户已经存在！") '提示本用户名已经被占用
          Exit Sub
                                
        ElseIf user(i) = TxtName.Text Then '如果输入员工用户名已经在用户列表 则提示
            MsgBox ("本用户已经存在")
          Exit Sub
        End If
    Next i
        
    DataA.Recordset.FindFirst "职工编号= " + Txtnew.Text

         If DataA.Recordset.NoMatch Then  '如果输入的员工编号不存在 则提示
            MsgBox ("本职员不存在")
         Exit Sub
           
         End If


    If TxtP1.Text = TxtP2.Text Then
        If Usercount = MxUser Then   '限制最大用户数目
            MsgBox "太多用户了"
            
        Else
            user(Usercount) = TxtName.Text
            pws(Usercount) = TxtP1.Text
            state(Usercount) = "A"
            Emplo(Usercount) = Txtnew.Text
                  
            Usercount = Usercount + 1  '当前用户数目＋1
            
            LsUser.AddItem TxtName.Text
                                  
            Frame1.Visible = False
            Call ActiveAll
            
             DataB.Recordset.AddNew  '向一个可修改的记录集对象插入一条新记录
            
            For i = 0 To 15
                 DataB.Recordset.Fields(i) = DataA.Recordset.Fields(i)
            Next i
                DataB.Recordset.Update '把对记录的任何改变写回数据库中，取代旧的记录
                
                   fil = FreeFile()
       
            Open App.Path + "\user.ini" For Output As #fil
    
            For i = 0 To Usercount - 1
                Print #fil, user(i); ","; pws(i); ","; state(i); ","; Emplo(i)
              
            Next i
   
            Close #fil

              Txtnew.Text = ""
              TxtName.Text = ""
              TxtP1.Text = ""
              TxtP2.Text = ""
        
        End If
                        
    Else
        MsgBox ("两次密码不一致，请重新输入！")
        TxtP1.Text = ""
        TxtP2.Text = ""
        TxtP1.SetFocus
        
    End If

End Sub

Private Sub LbAdduser_Click()
    Frame1.Visible = True
    Call DeadAll
    
End Sub

Private Sub Label9_dblClick()   '删除 用户

    If LsUser.Text <> "" Then  '判定是否选定用户
        
        For i = 1 To Usercount - 1
            If LsUser.Text = user(i) Then
                state(i) = "L"    '改写用户状态为限制用户
                LsLimt.AddItem (LsUser.Text)
                LsUser.RemoveItem (LsUser.ListIndex)
            End If
        Next i
                
    End If

End Sub

Private Sub Label10_dblClick()  ' 激活 用户

    If LsLimt.Text <> "" Then
    
        For i = 1 To Usercount - 1
            If LsLimt.Text = user(i) Then
            
               state(i) = "A"     '将用户状态改写为 A
               LsUser.AddItem (LsLimt.Text)
               LsLimt.RemoveItem (LsLimt.ListIndex)
              
            End If
        
        Next i
    
    End If

End Sub

Private Sub LbChange_Click()  '变更密码
    
    If LsUser.Text <> "root" And LsUser.Text <> "" Then  '非超级用户的
        Call DeadAll
        Frame2.Visible = True
        FrmMain.Pwin = "FrmSys"
        Frame2.Caption = "当前用户：" + LsUser.Text
    ElseIf LsUser.Text = "root" Then
        Call DeadAll
        FrmPsw.Show
        FrmPsw.Label1.Caption = "修改超级用户密码"
    Else
        MsgBox "请选择用户！"
        Exit Sub
    End If

End Sub

Private Sub LbFire_dblClick()
   
   For i = 1 To Usercount - 1
        If LsLimt.Text = user(i) Then
          state(i) = "F"
          LsLimt.RemoveItem (LsLimt.ListIndex)
        End If
    Next i

End Sub

Private Sub LsLimt_Click()

Dim str As String
    
    If LsLimt.Text <> "" Then
        LsUser.ListIndex = -1
    
        For i = 1 To Usercount - 1
            If LsLimt.Text = user(i) Then
                DataB.Recordset.FindFirst "职工编号=" + Emplo(i)
            End If
        Next i
        
        If DataB.Recordset.NoMatch Then
            LbNote.Caption = "没有此用户"
        Else
            str = ""
            With DataB.Recordset
                str = str + " 职员编号： " + CStr(.Fields(0)) + " 姓名：" + CStr(.Fields(1))
                str = str + " 毕业学校：" + CStr(.Fields(6)) + " 部门：" + CStr(.Fields(8))
                str = str + " 职位：" + CStr(.Fields(9)) + " 电话：" + CStr(.Fields(11))
            End With
    
            LbNote.Caption = str
        End If
    
    End If

End Sub

Private Sub LsUser_Click()

Dim str As String
    
    If LsUser.Text <> "" Then
        LsLimt.ListIndex = -1
    
        For i = 0 To Usercount - 1
            If LsUser.Text = user(i) Then
                DataB.Recordset.FindFirst "职工编号=" + Emplo(i)
                Exit For
                        
            End If
        Next i
        
        If DataB.Recordset.NoMatch Then
            LbNote.Caption = "没有此用户"
        Else
            str = ""
            With DataB.Recordset
                str = str + "职员编号： " + CStr(.Fields(0)) + " 姓名：" + CStr(.Fields(1))
                str = str + " 毕业学校：" + CStr(.Fields(6)) + " 部门：" + CStr(.Fields(8))
                str = str + " 职位：" + CStr(.Fields(9)) + " 电话：" + CStr(.Fields(11))
            End With
    
            LbNote.Caption = str
        End If
    
    End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
    FrmMain.Enabled = True
    FrmMain.SetFocus
    Unload Me

End Sub

Private Sub Txtnew_KeyPress(KeyAscii As Integer)
        If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> vbKeyBack Then
                KeyAscii = 0
                Exit Sub
        End If
End Sub