机房收费系统（二）-登录

我在敲机房之前，看了两天师哥师姐的博客，发现师哥师姐们每敲一个窗体都会画一个流程图，这样可以让自己在敲之前有一个清晰的思路，防止逻辑混乱。

- 流程图
-

- 部分代码展示：

Private Sub cmdOK_Click()
 Dim txtSQL As String
 Dim txtSQL1 As String
 Dim txtSQL2 As String
 Dim mrc As ADODB.Recordset
 Dim MsgText As String
 Dim MsgText1 As String
 Dim mrc3 As ADODB.Recordset
 Dim mrc1 As ADODB.Recordset
 Dim mrc2 As ADODB.Recordset
 Dim UserLevel As String
 If Trim(txtUserName.Text = "") Then
     MsgBox "没有这个用户，请重新输入用户名！", vbOKOnly + vbExclamation, "警告"
     txtUserName.SetFocus
 Else
     txtSQL = "select * from user_Info where userID = '" & txtUserName.Text & "'"
 Set mrc = ExecuteSQL(txtSQL, MsgText)
 If mrc.EOF Then
     MsgBox "用户名不正确，请重新输入！", vbOKOnly + vbExclamation, "警告"
     txtUserName.SetFocus
 Else
 If Trim(mrc.Fields(1)) = Trim(txtPassword.Text) Then
    OK = True
    Me.Hide
    txtUserName = Trim(txtUserName.Text)
    txtSQL = "select * from OnWork_Info where UserID = '" & txtUserName.Text & "'"
Set mrc1 = ExecuteSQL(txtSQL, MsgText)
   mrc1.AddNew
   mrc1.Fields(0) = Trim(txtUserName.Text)
   mrc1.Fields(1) = Trim(mrc.Fields(2))
   mrc1.Fields(2) = Date
   mrc1.Fields(3) = Time
   mrc1.Fields(4) = VBA.Environ("computername")
   mrc1.Update

 txtSQL2 = "select * from worklog_Info "
Set mrc2 = ExecuteSQL(txtSQL2, MsgText)
    mrc2.AddNew
    mrc2.Fields(1) = Trim(txtUserName.Text)
    mrc2.Fields(2) = Trim(mrc1.Fields(1))
    mrc2.Fields(3) = Trim(mrc1.Fields(2))
    mrc2.Fields(4) = Trim(mrc1.Fields(3))
    mrc2.Fields(7) = VBA.Environ("computername")
    mrc2.Fields(8) = "True"
 mrc2.Update
 mrc2.Close
 mrc1.Close

 txtSQL = "select * from User_Info Where userID ='" & Trim(txtUserName.Text) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
 If mrc.EOF = False Then
   UserLevel = Trim(mrc.Fields(2))
  If Trim(UserLevel) = "操作员" Then
    frmMain.caozuoyuan.Enabled = True
    frmMain.yibanyonghu.Enabled = True
    frmMain.guanliyuan.Enabled = False
    frmMain.guanliyuan.Visible = False
   mrc.Close

 End If
End If

 frmMain.Show
 Else
      MsgBox "输入密码不正确，请重新输入！", vbOKOnly + vbExclamation, "警告"
      txtUserName.SetFocus
      txtUserName.Text = ""
 End If


End If
 End If

miCount = miCount + 1
 If miCount = 3 Then
 Me.Hide
End If
 Exit Sub

End Sub

• 最后还要限制一下用户名不能输入特殊字符：

 If KeyAscii > 31 And KeyAscii < 48 Or KeyAscii > 57 And KeyAscii > 90 And KeyAscii < 97 Or KeyAscii > 122 And KeyAscii < 127 Then
      MsgBox "不能输入特殊字符，请输入数字或字母", 0 + 48, "警告"
      KeyAscii = 0 '使输入的特殊字符为空字符
    End If