userform.frm

这个是VB环境开发的,我也是转载的把原来的Access数据库改成了SQl Server数据库.希望大家可以借鉴

      ForeColor       =   &H80000008&
      Height          =   210
      Index           =   1
      Left            =   240
      TabIndex        =   16
      Top             =   600
      Width           =   945
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "用户名称:"
      ForeColor       =   &H80000008&
      Height          =   210
      Index           =   0
      Left            =   240
      TabIndex        =   15
      Top             =   120
      Width           =   945
   End
End
Attribute VB_Name = "UserForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Idx As Integer


Private Sub LoadUserToMsfObject()
    MSF.Rows = 1
    Set rs = New ADODB.Recordset
    rs.Source = "select * from usertable"
    rs.Open , cn, adOpenKeyset, adLockOptimistic
    Do Until rs.EOF
        MSF.AddItem rs.Fields("UserName")
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
End Sub

Private Sub CmdAdd_Click()
    Txt(0).Enabled = True
    Txt(1).Enabled = True
    Txt(2).Enabled = True
    Txt(0).Text = ""
    Txt(1).Text = ""
    Txt(2).Text = ""
    cmdadd.Enabled = False
    CmdCancel.Enabled = True
    Opt(0).Value = True
    If Txt(0).Enabled = True Then
       Txt(0).SetFocus
    End If
    Flg = True
End Sub


Private Sub CmdCancel_Click()
    cmdadd.Enabled = True
    cmdOK.Enabled = False
    Txt(0).Text = ""
  '  Txt(1).Text = "weicls"
  '  Txt(2).Text = "weicls"
    Opt(0).Value = True
    cmdOK.Enabled = False
    Txt(0).Enabled = False
    CmdCancel.Enabled = False
    cmdadd.SetFocus
End Sub

Private Sub CmdDelete_Click()
 On Error GoTo l
    CmdCancel.Enabled = False
    Dim Re As String
    Set rs = New ADODB.Recordset
    rs.Source = "select * from usertable where username='" & Txt(0).Text & "'"
    rs.Open , cn, adOpenKeyset, adLockOptimistic
     Re = MsgBox("  您确定要删除吗?  ", vbYesNo + vbQuestion, ginfo)
    If UsrName = rs!UserName Then
       If Re = 6 Then
          If MSF.Rows <> 2 Then
             MSF.RemoveItem MSF.row
          Else
             MsgBox "    您无法删除此用户!   ", , ginfo
             rs.Close
             Exit Sub
          End If
          rs.Delete adAffectCurrent
       Else
          rs.Close
          Set rs = Nothing
          Exit Sub
       End If
    Else
      If Re = 6 Then
        If MSF.Rows <> 2 Then
            MSF.RemoveItem MSF.row
            rs.Delete adAffectCurrent
        Else
            MsgBox "    您无法删除此用户！   ", , ginfo
            rs.Close
            Exit Sub
        End If
       End If
    End If
    rs.Close
    Set rs = Nothing
    Txt(0).Text = ""
    Txt(1).Text = ""
    Txt(2).Text = ""
    cmdOK.Enabled = False
    CmdDelete.Enabled = False
    cmdadd.Enabled = True
    Opt(0).Value = True
    cmdadd.SetFocus
    Exit Sub
l:   MsgBox "   此用户进行过出入库操作不能删除！  ", , ginfo
     LoadUserToMsfObject
   Exit Sub

End Sub

Private Sub cmdexit_Click()
    Unload Me
End Sub

Private Sub CmdOk_Click()
On Error GoTo gl
    If Txt(1).Enabled = False Then
     If rs.State Then
       rs.Close
     End If
     rs.Source = "select  * from usertable where username= '" & MSF.TextMatrix(MSF.row, 0) & "'"
     rs.Open , cn, adOpenKeyset, adLockOptimistic
     rs!UserName = Trim(Txt(0).Text)
     rs.Update
     rs.Close
     Set rs = Nothing
      MSF.TextMatrix(MSF.row, 0) = Txt(0).Text
     cmdadd.Enabled = True
     cmdadd.SetFocus
     Exit Sub
   End If
   CmdCancel.Enabled = False
    If Len(Trim(Txt(2).Text)) = 0 Or Len(Trim(Txt(0).Text)) = 0 Or Len(Trim(Txt(1).Text)) = 0 Then
       MsgBox " 数据不完整，请检查！ ", , "提示信息"
       Exit Sub
    End If
    If Trim(Txt(2).Text) <> Trim(Txt(1).Text) Then
       MsgBox " 两次密码值不相等！ ", , ginfo
       Exit Sub
    End If
    Set rs = New ADODB.Recordset
    rs.Source = "select  * from usertable order by id"
    rs.Open , cn, adOpenKeyset, adLockOptimistic
    If rs.RecordCount <> -1 Then
         rs.MoveLast
         Idadd = rs!ID
     Else
         Idadd = 1
     End If
    If Flg Then rs.AddNew
    rs!ID = Idadd + 1
    rs!UserName = Txt(0).Text
    rs!userpwd = Txt(1).Text
    rs!userdep = UsrDepartment
    rs.Update
    rs.Close
    Set rs = Nothing
    MSF.AddItem Txt(0).Text
    cmdadd.Enabled = True
    cmdOK.Enabled = False
    CmdDelete.Enabled = False
    cmdadd.SetFocus
    Exit Sub
gl:    MsgBox err.Description
End Sub

Private Sub cmdpwdedit_Click()
frmChangePassword.Show 1
End Sub

Private Sub Form_Load()
    UsrDepartment = "MainManager"
   
    LoadUserToMsfObject
End Sub

Private Sub MSF_DblClick()
   If MsgBox("是否显示当前记录？", vbYesNo, "显示当前记录") = vbYes Then
        Set rs = New ADODB.Recordset
        rs.Source = "select * from usertable where username='" & MSF.TextMatrix(MSF.row, 0) & "'"
        rs.Open , cn, adOpenKeyset, adLockOptimistic
        If Not (rs.EOF Or rs.BOF) Then
        Txt(0).Text = rs!UserName
  
        If MSF.TextMatrix(1, 0) = UsrName Then
           CmdDelete.Enabled = True
        End If
        UsrDeparment = Trim(rs!userdep)

        cmdadd.Enabled = True
        cmdOK.Enabled = True
        CmdCancel.Enabled = True
        If UsrName = MSF.TextMatrix(1, 0) Then
            Txt(0).Enabled = True
        Else
            Txt(0).Enabled = False
        End If
        Txt(1).Enabled = False
        Txt(2).Enabled = False
        Flg = False
        cmdadd.SetFocus
        End If
    Else
        CmdCancel.Enabled = True
        CmdCancel_Click
        cmdadd.SetFocus
        CmdCancel.Enabled = False
    End If
End Sub

Private Sub Opt_Click(Index As Integer)
    Idx = Index
End Sub

Private Sub Opt_KeyPress(Index As Integer, KeyAscii As Integer)
    
    If KeyAscii = 13 Then
        cmdOK.Enabled = True
        cmdOK.SetFocus
    End If

End Sub

Private Sub Txt_Change(Index As Integer)
    
    If Len(Txt(Index).Text) > 0 Then cmdOK.Enabled = True

End Sub

Private Sub Txt_GotFocus(Index As Integer)
    
    Txt(Index).SelStart = 0
    Txt(Index).SelLength = Len(Trim(Txt(Index).Text))

End Sub

Private Sub Txt_KeyPress(Index As Integer, KeyAscii As Integer)
    
    If KeyAscii = 13 And Len(Txt(Index).Text) > 0 Then
        Select Case Index
            Case 0
                Txt(1).SetFocus
            Case 1
                Txt(2).SetFocus

        End Select
    End If

End Sub