'以下的是我刚写的,没有调试过。用的是Access数据库。
Option Explicit
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rs1 As ADODB.Recordset
Private Sub CmdOK_Click()
   Dim ConStr As String
   If TxtUserName.Text = "" Then
      MsgBox "請輸入用戶名!", vbOKOnly + vbExclamation, "登錄"
      TxtUserName.SetFocus
      Exit Sub
   End If
   Set cn = New ADODB.Connection
   Set rs = New ADODB.Recordset
   ConStr = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                        & "Data Source=" & App.Path & "\StuAcc.Mdb"
   cn.Open ConStr
   cn.CursorLocation = adUseServer
   rs.Open "Select * From User_Property", cn, adOpenKeyset, adLockPessimistic
   If rs.RecordCount > 0 Then
      If TxtUserName.Text <> "" Then
         Set rs1 = New ADODB.Recordset
         rs1.Open "Select * From User_Property Where User_Name= '" & TxtUserName.Text & "'", cn, adOpenKeyset, adLockPessimistic
         If rs.RecordCount > 0 Then
            If TxtPassWord.Text <> "" Then
               If rs.Fields("User_Name") = TxtUserName.Text And rs.Fields("User_password") = TxtPassWord.Text And rs.Fields("User_Popedom") = Cbop.Text Then
                   FrmMain.Show
                   rs1.Close
                   Unload Me
               Else
                  If rs1.Fields("User_password") <> TxtPassWord.Text Then
                      MsgBox "密碼錯誤,請與管理員聯系!", vbCritical + vbOKOnly, "密碼錯誤"
                      TxtPassWord.SetFocus
                      TxtPassWord.SelStart = 0
                      TxtPassWord.SelLength = Len(TxtPassWord.Text)
                      Exit Sub
                  Else
                     If rs1.Fields("User_Popedom") <> Cbop.Text Then
                        MsgBox "權限錯誤,請與管理員聯系!", vbOKOnly + vbCritical, "權限錯誤"
                        Cbop.SetFocus
                        Exit Sub
                     End If
                  End If
               End If
            Else
               MsgBox "請輸入密碼!", vbOKOnly, "登錄"
               TxtPassWord.SetFocus
               Exit Sub
            End If
         Else
            MsgBox "沒有該用戶,請與管理員聯系!", vbOKCancel + vbExclamation, "登錄"
            Exit Sub
         End If
       End If
   Else
      MsgBox "沒有用戶信息,請確定!", vbExclamation + vbOKCancel, "登錄"
      TxtUserName.SetFocus
      Exit Sub
   End If
   rs.Close
End Sub
Private Sub CmdCancle_Click()
   Unload Me
End Sub
Private Sub Form_Load()
   Move Screen.Width / 2 - Width / 2, Screen.Height / 2 - Height / 2
   Cbop.AddItem "管理員"
   Cbop.AddItem "普通操作員"
   Dim MyConStr As String
   Dim UserCount As Integer
   Dim Mycn As New ADODB.Connection
   Dim Myrs As New ADODB.Recordset
   MyConStr = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                 & "Data Source=" & App.Path & "\StuAcc.mdb"
   Mycn.Open MyConStr
   Mycn.CursorLocation = adUseClient
   Myrs.Open "Select * From User_Property", Mycn, adOpenKeyset, adLockPessimistic
   If Myrs.RecordCount <= 0 Then
      UserCount = MsgBox("沒有用戶,請先注冊!", vbYesNo + vbExclamation, "登錄")
      If UserCount = vbYes Then FrmAddUser.Show
      Myrs.Close
      Mycn.Close
      Set Myrs = Nothing
      Set Mycn = Nothing
      Unload Me
   End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
   Set cn = Nothing
End Sub