VB机房管理

VB机房管理系统的BUG

                                    **张洋洋**

关于VB版机房调调试试也很久了，以前也没太在乎特意的去观察调试，心不定总会带来其他的小错误，今天写一个连接数据库的错误吧！

此为frmLogin登录按钮代码↓

Private Sub cmdOk_Click()Dim txtsql As String '用来存放SQL语句Dim mrc As adodb.Recordset   '用来存放记录集对象Dim MsgText As String     '用来存放返回信息Dim mrc1 As adodb.RecordsetDim mrc2 As adodb.RecordsetDim txtSQL2 As StringDim MsgText2 As StringDim txtSQL1 As StringDim MsgText1 As StringDim MsgText3 As StringDim txtSQL3 As StringDim mrc3 As adodb.RecordsetDim deow As adodb.RecordsettxtSQL2 = "select * from onwork_info where userId='" & txtUsername.Text & "'"Set mrc2 = ExecuteSQL(txtSQL2, MsgText2)username = ""If Trim(txtUsername.Text = "") Then    MsgBox "卡号不能为空，请重新输入用户名！", vbOKOnly + vbExclamation, "警告"    txtUsername.SetFocus    txtUsername.Text = ""    txtPassword.Text = ""Else     If mrc2.EOF = True Then         txtsql = "select* from user_info where userID= '" & txtUsername.Text & "'" '查询指定用户名的记录         Set mrc = ExecuteSQL(txtsql, MsgText)     If mrc.EOF Then            MsgBox "没有这个用户，请重新输入用户名！", vbOKOnly + vbExclamation, "提示"            txtUsername.SetFocus            txtUsername.Text = ""            txtPassword.Text = ""       Else           txtSQL1 = "select * from onwork_info where userID= '" & txtUsername.Text & "'"           Set mrc1 = ExecuteSQL(txtSQL1, MsgText1)           If Trim(mrc.Fields(1)) = Trim(txtPassword.Text) Then '            ok = True            Me.Hide            username = Trim(txtUsername.Text)            If Trim(mrc.Fields(2)) = "管理员" Then            Else            If Trim(mrc.Fields(2)) = "操作员" Then                 frmmain.adminMenu.Enabled = False              Else                 frmmain.adminMenu.Enabled = False                 frmmain.operatorMenu.Enabled = False          End If          End If     frmmain.Show        Else            MsgBox "输入密码不正确，请重新输入！", vbOKOnly + vbExclamation, "提示"            txtPassword.Text = ""            txtPassword.SetFocus            End If            mrc1.AddNew            mrc1.Fields(0) = txtUsername.Text            mrc1.Fields(1) = mrc.Fields(2)            mrc1.Fields(2) = Date            mrc1.Fields(3) = Time            mrc1.Fields(4) = Trim(frmIPadd.Text1.Text)            mrc1.Update            mrc1.Close '在能够登陆的情况下网worklog表里添加记录            txtSQL3 = "select * from worklog_info where userID= '" & txtUsername.Text & "'"            Set mrc3 = ExecuteSQL(txtSQL3, MsgText3)            mrc3.AddNew            mrc3.Fields(1) = username            mrc3.Fields(2) = mrc.Fields(2)            mrc3.Fields(3) = Date            mrc3.Fields(4) = Time      mrc3.Fields(7) =           Trim(frmIPadd.Text1.Text)            mrc3.Fields(8) = "true"            mrc3.Update            mrc3.Close            mrc.Close    End If    Else      MsgBox "该用户正在登录，您可再单击实现二次登录！", vbOKOnly + vbExclamation, "提示"   mrc2.Delete   mrc2.Update   mrc2.Close    End If

此为主窗体frmmain退出，添加Worklog代码：↓

   Dim txtsql As String  Dim mrc As adodb.Recordset  Dim MsgText As String  Dim a As Integer  Dim txtSQL1 As String  Dim mrc1 As adodb.Recordset  Dim MsgText1 As String  Dim MsgText2 As String  Dim mrc2 As adodb.Recordset  Dim txtSQL2 As String  txtsql = "select * from worklog_info where userID= '" & username & "'and status='true'"  Set mrc = ExecuteSQL(txtsql, MsgText)  txtSQL1 = "select * from onwork_info"  Set mrc1 = ExecuteSQL(txtSQL1, MsgText1)  a = MsgBox("确定要退出本程序吗?", vbOKCancel, "关闭程序")  If a = vbOK Then '退出程序 Cancel = False On Error Resume Next mrc.Fields(5) = Date mrc.Fields(6) = lbltime.Caption mrc.Update mrc1.Delete mrc1.Update mrc1.Close  End If   EndEnd Sub

上边代码调试以后会出现以下的错误，如图所示：图1

经过长时间多次的登录调试，出现以上LogoutDate，LogoutTime出现在一个不对位的情况，如果以UserName为主的话，多次一样的Username出现的这样的情况。

由于是小白so.想了很多办法也没有想到解决的办法…
由错误worklog图可以看出，由于UserID（全局username），可以看出存入数据库时都是相同的UserID出现此类错误。数据找不到家，就随便安了一个家。

  txtsql = "select * from worklog_info where userID= '" & username & "'and status='true'"  Set mrc = ExecuteSQL(txtsql, MsgText)

Now开始解问题，如下图

全解决，添加退出记录时，让mrc游标移动到最后更新就解决了，谢谢！

• 加粗 Ctrl + B
• 斜体 Ctrl + I
• 引用 Ctrl + Q
• 插入链接 Ctrl + L
• 插入代码 Ctrl + K
• 插入图片 Ctrl + G
• 提升标题 Ctrl + H
• 有序列表 Ctrl + O
• 无序列表 Ctrl + U
• 横线 Ctrl + R
• 撤销 Ctrl + Z
• 重做 Ctrl + Y