机房整体总结

机房自己计划一个月完成，可是中途时间有点紧，所以往后推迟了半个月，说起机房，最重要的就是逻辑，做完机房最大的感受就是首先要把逻辑搞清，不然越做越乱，只会给自己添加负担，让自己的思路一塌糊涂。

在敲机房的时候，总结了几条，和大家分享：

1.代码格式要正确、清晰。以便于后面调错。

2.注释要简洁、有力。

3.做组合查询、上下机、结账时一定要先画流程图。

4.结账要分清是谁给谁结账，结的什么账。

5.数据库中的类型要搞清楚，有的时候不是程序的错误，而是数据库中有错误。

下面是一些重要的代码和大家分享：

上机代码：

Private Sub cmdUP_Click()
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    Dim mrc1 As ADODB.Recordset
    Dim mrc2 As ADODB.Recordset
    Dim mrc3 As ADODB.Recordset
    Dim mrc4 As ADODB.Recordset
    
    '链接basicdata表
    txtSQL = "select * from basicdata_info "
    Set mrc2 = ExecuteSQL(txtSQL, MsgText)
    '链接line表
    txtSQL = "select * from line_info "
    Set mrc3 = ExecuteSQL(txtSQL, MsgText)

    'online表总记录数
    txtSQL = "select * from online_info "
    Set mrc4 = ExecuteSQL(txtSQL, MsgText)
    
    '判断卡号是否为空
    If txtcardno.Text = "" Then
        MsgBox "卡号不能为空。", vbOKOnly + vbExclamation, "提示"
        txtcardno.SetFocus
        GoTo 1
    End If
    
    '判断卡号是否为数字
    If Not IsNumeric(Trim(txtcardno.Text)) Then
        MsgBox "请输入数字！", vbOKOnly + vbExclamation, "警告"
        txtcardno.Text = ""
        txtcardno.SetFocus
        Exit Sub
    End If
    
    '链接学生表
    txtSQL = "select * from student_info where cardno='" & Trim(txtcardno.Text) & "'and status='使用'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    '判断卡号是否退卡
    If mrc.EOF Then
        MsgBox "此卡已经退卡", vbOKOnly + vbExclamation, "提示"
        txtcardno.Text = ""
        txtcardno.SetFocus
        GoTo 1
    Else
    
    '链接online表
     txtSQL = "select * from online_info where cardno='" & Trim(txtcardno.Text) & "'"
     Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    
        '判断此卡是否上机
        If mrc1.EOF = False Then
            MsgBox "此卡正在上机", vbOKOnly + vbExclamation, "提示"
            '调用正在上机信息到页面
            txtcardno.Text = mrc1!cardno
            txtType.Text = mrc1!cardtype
            txtSNo.Text = mrc1!studentNo
            txtSName.Text = mrc1!studentName
            txtDepartment.Text = mrc1!department
            txtSex.Text = mrc1!sex
            txtOnDate.Text = mrc1!ondate
            txtOnTime.Text = mrc1!ontime
            txtcardno.SetFocus

        Else
            '判断余额
            If Val(mrc.Fields(7)) < Trim(mrc2.Fields(5)) Then
                MsgBox "余额不足，请先充值。"
                txtcardno.SetFocus
                GoTo 1
            Else
                '调用学生信息到输入框。上机成功
                txtcardno.Text = mrc.Fields(0)
                txtType.Text = mrc.Fields(14)
                txtSNo.Text = mrc.Fields(1)
                txtSName.Text = mrc.Fields(2)
                txtDepartment.Text = mrc.Fields(4)
                txtSex.Text = mrc.Fields(3)
                txtcash.Text = mrc.Fields(7)
                txtOnDate.Text = Date
                txtOnTime.Text = Time
                txtOffDate.Text = ""
                txtOffTime.Text = ""
                txtCMoney.Text = ""
                txtCTime = ""
            
            End If
        End If
    End If
    
    '1 链接online表
    txtSQL = "select * from online_info where cardno='" & Trim(txtcardno.Text) & "'"
    Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    With mrc1
        .AddNew
        .Fields(0) = Trim(txtcardno.Text)
        .Fields(1) = Trim(txtType.Text)
        .Fields(2) = Trim(txtSNo.Text)
        .Fields(3) = Trim(txtSName.Text)
        .Fields(4) = Trim(txtDepartment.Text)
        .Fields(5) = Trim(txtSex.Text)
        .Fields(6) = Date
        .Fields(7) = Time
        .Fields(8) = VBA.Environ("computername")
        .Fields(9) = Now
        .Update
        .Close
    End With
    
    '添加line表
    With mrc3
        .AddNew
        .Fields(1) = Trim(txtcardno.Text)
        .Fields(2) = Trim(txtSNo.Text)
        .Fields(3) = Trim(txtSName.Text)
        .Fields(4) = Trim(txtDepartment.Text)
        .Fields(5) = Trim(txtSex.Text)
        .Fields(6) = Date
        .Fields(7) = Time
        .Fields(13) = "正在上机"
        !COMPUTER = VBA.Environ("computername")
        .Update
        .Close
    End With
    Timer2.Enabled = True
    MsgBox "上机成功", vbInformation, "提示"
    '更新学生表
    With mrc
        .Fields(11) = "未结账"
        .Update
        .Close
    End With
    
    
End Sub

下机代码：

Private Sub cmdOffLine_Click() '下机
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    Dim mrc1 As ADODB.Recordset
    Dim mrc2 As ADODB.Recordset
    Dim mrc3 As ADODB.Recordset
    Dim mrc4 As ADODB.Recordset
    Dim mrc5 As ADODB.Recordset
    Dim ct As String
    Dim linetime As Integer  '用于存储实际在线时间
    '链接学生表
    txtSQL = "select * from student_info where cardno='" & Trim(txtcardno.Text) & "' and status='使用'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    'online表
    txtSQL = "select * from online_info where cardno='" & Trim(txtcardno.Text) & "'"
    Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    
    '2
    txtSQL = "select * from online_info "
    Set mrc2 = ExecuteSQL(txtSQL, MsgText)
    
    '3 基本数据表
    txtSQL = "select * from basicdata_info "
    Set mrc3 = ExecuteSQL(txtSQL, MsgText)
    
    '4 上机记录
    txtSQL = "select * from line_info where cardno='" & Trim(txtcardno.Text) & "' and status='正在上机'"
    Set mrc4 = ExecuteSQL(txtSQL, MsgText)
    
    '5 online 记录条数
    txtSQL = "select * from online_info"
    Set mrc5 = ExecuteSQL(txtSQL, MsgText)
    
    If Not IsNumeric(Trim(txtcardno.Text)) Then
        MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    End If
    
    '页面更新信息
    If mrc1.EOF Then
        MsgBox "此卡没有上机", vbInformation, "提示"
        GoTo 1
    Else
        txtcardno.Text = txtcardno.Text
        txtSNo.Text = mrc1!studentNo
        txtType.Text = mrc1!cardtype
        txtSName.Text = mrc1!studentName
        txtSex.Text = mrc1!sex
        txtDepartment.Text = mrc1!department
        txtOnTime.Text = mrc1!ontime
        txtOnDate.Text = mrc1!ondate
        txtOffTime.Text = Time
        txtOffDate.Text = Format(Date, "yyyy-mm-dd")
'        '在线时长计算
        linetime = (Date - DateValue(mrc1!ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrc1!ontime))) * 60 + (Minute(Time) - Minute(TimeValue(mrc1!ontime))) '时间单位为分钟
    
'        If linetime < Trim(mrc3.Fields(4)) Then
'            txtcash = mrc.Fields(7)
'            txtCTime.Text = "0"
'            txtCMoney.Text = "0"
'            Ccash = "0"
'        Else
        
        If Trim(mrc.Fields(14)) = "固定用户" Then '固定用户消费
                Money = Trim(mrc3.Fields(0)) * Int(((linetime / mrc3.Fields(2)) + 1))
                Ccash = Trim(mrc.Fields(7)) - Trim(Money)
                mrc.Fields(7) = Trim(mrc!cash) - Money
                txtCTime.Text = linetime
                txtcash.Text = Ccash
                txtCMoney.Text = Money
                mrc.Fields(8) = Money
                mrc.Update
        Else
                Money = Trim(mrc3.Fields(1)) * Int(((linetime / mrc3.Fields(2)) + 1))
                Ccash = Trim(mrc.Fields(7)) - Trim(Money)
                mrc.Fields(7) = Trim(mrc!cash) - Money
                txtcash.Text = Ccash
                txtCTime.Text = linetime
                txtCMoney.Text = Money
                mrc.Fields(8) = Money
                mrc.Update
        End If
'        End If
        '删除line表中上机的记录
        txtSQL = "select * from line_info where cardno='" & Trim(txtcardno.Text) & "'and status='正在上机'"
        Set mrc4 = ExecuteSQL(txtSQL, MsgText)
        mrc4.Delete
        mrc4.Update
        '更新line表
        With mrc4
            .AddNew
            .Fields(1) = Trim(txtcardno.Text)
            .Fields(2) = Trim(txtSNo.Text)
            .Fields(3) = Trim(txtSName.Text)
            .Fields(4) = Trim(txtDepartment.Text)
            .Fields(5) = Trim(txtSex.Text)
            .Fields(6) = mrc1!ondate
            .Fields(7) = mrc1!ontime
            !COMPUTER = VBA.Environ("computername")
            !offdate = Trim(txtOffDate.Text)
            !offtime = Trim(txtOffTime.Text)
            !consumetime = Trim(txtCTime.Text)
            !consume = Trim(txtCMoney.Text)
            !cash = Trim(Ccash) & ""
            !Status = "正常下机"
            .Update
            .Close
        End With
        '更新online表
        mrc1.Delete
        mrc1.Update
        mrc1.Close
    End If
    
    '5 online 记录条数
1:   Dim mrcOnline As ADODB.Recordset
     Dim OnlineSQL As String
     Dim OnMsgtext As String

  
    '显示正在上机的人数
    OnlineSQL = "select * from OnLine_Info"
    Set mrcOnline = ExecuteSQL(OnlineSQL, OnMsgtext)
        If mrcOnline.EOF = True Then
            Label21.Caption = 0
        Else
            Label21.Caption = mrcOnline.RecordCount
        End If
End Sub

组合查询代码：

Private Sub btnInquire_Click()
    Dim ctrl As Control
    Dim mrc As ADODB.Recordset
    Dim txtSQL As String
    Dim MsgText As String
    Dim i, iCols As Integer '让所有列都居中显示文字
    Dim a0, a1, a2
    a0 = Text1.Text
    a1 = Text2.Text
    a2 = Text3.Text

     '检查条件输入
    If Trim(Combo1.Text) = "" Or Trim(Combo2(0).Text) = "" Or Trim(Text1.Text) = "" Then
        MsgBox "请输入完整的查询条件", , "提示"
        Exit Sub
    End If
    iCols = MSHFlexGrid1.Cols
    For i = 0 To iCols - 1
        MSHFlexGrid1.ColAlignment(i) = flexAlignCenterCenter
    Next i
 
    txtSQL = "select * from student_Info where "
    txtSQL = txtSQL & " " & field(Combo1.Text) & " " & Trim(Combo2(0).Text) & "'" & Trim(a0) & "'"
    If Trim(Combo3(0).Text <> "") Then '第一个组合关系存在
        If Trim(Combo4.Text) = "" Or Trim(Combo2(1).Text = "") Or Trim(a0 = "") Then
            MsgBox "你已经选择了第一个组合关系，请输入第二行查询条件", , "提示"
            Exit Sub
        Else
            txtSQL = txtSQL & field(Trim(Combo3(0).Text)) & " " & field(Combo4.Text) & Combo2(1).Text & "'" & Trim(a1) & "'"
        End If
    End If
 
    If Trim(Combo3(1).Text <> "") Then '第二个组合关系存在
        If Trim(Combo5.Text) = "" Or Trim(Combo2(2).Text) = "" Or Trim(a2) = "" Then
            MsgBox "你已经选择了第二个组合关系，请输入第三行查询条件", , "提示"
            Exit Sub
        Else
            txtSQL = txtSQL & field(Combo3(1).Text) & " " & field(Combo5.Text) & Combo2(2).Text & "'" & Trim(a2) & "'"
        End If
    End If
 
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF = True Then '检查信息是否存在，如果不存在给出提示并清空所有文本框
        MsgBox "没有查询到结果，可能会你输入的信息不存在，或者信息矛盾"
        MSHFlexGrid1.Clear
        '...清空所有文本框
        Exit Sub
    End If
    With MSHFlexGrid1
        .Rows = 1
        .TextMatrix(0, 0) = "卡号"
        .TextMatrix(0, 1) = "学号"
        .TextMatrix(0, 2) = "姓名"
        .TextMatrix(0, 3) = "性别"
        .TextMatrix(0, 4) = "系别"
        .TextMatrix(0, 5) = "年级"
        .TextMatrix(0, 6) = "班级"
        .TextMatrix(0, 7) = "金额"
        .TextMatrix(0, 8) = "类型"
        .TextMatrix(0, 9) = "状态"
        .TextMatrix(0, 10) = "日期"
        .TextMatrix(0, 11) = "时间"
 
 
     Do While Not mrc.EOF
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = Trim(mrc!cardno)
            .TextMatrix(.Rows - 1, 1) = Trim(mrc!studentNo)
            .TextMatrix(.Rows - 1, 2) = Trim(mrc!studentName)
            .TextMatrix(.Rows - 1, 3) = Trim(mrc!sex)
            .TextMatrix(.Rows - 1, 4) = Trim(mrc!department)
            .TextMatrix(.Rows - 1, 5) = Trim(mrc!grade)
            .TextMatrix(.Rows - 1, 6) = Trim(mrc!Class)
            .TextMatrix(.Rows - 1, 7) = Trim(mrc!cash)
            .TextMatrix(.Rows - 1, 8) = Trim(mrc!Type)
            .TextMatrix(.Rows - 1, 9) = Trim(mrc!Status)
            .TextMatrix(.Rows - 1, 10) = Trim(mrc!Date)
            .TextMatrix(.Rows - 1, 11) = Trim(mrc!Time)
           
            
            mrc.MoveNext
 
           
        Loop
    End With
    mrc.Close
End Sub

实时动态查询余额代码：

Private Sub Timer2_Timer()
  Dim txtSQL As String
  Dim MsgText As String
  Dim mrcOnL As ADODB.Recordset
  Dim mrcStu As ADODB.Recordset
  Dim mrcBas As ADODB.Recordset
  Dim mrc5 As ADODB.Recordset
  Dim Balance As Integer

 '将OnLine表与student表进行连接
  txtSQL = "select cash from student_Info,OnLine_Info where 
  student_Info.cardno=OnLine_Info.cardno "
  Set mrcStu = ExecuteSQL(txtSQL, MsgText)

    txtSQL = "select * from online_info"
    Set mrcOnL = ExecuteSQL(txtSQL, MsgText)
    If mrcOnL.EOF Then
        Timer2.Enabled = False      '如果数据库为空，则Timer停止
    Else
        mrcOnL.MoveFirst      '从第一条记录开始查询
    End If
      
    ReDim DynCard(mrcOnL.RecordCount) As String   '定义卡号数组
    For Intindex = 0 To mrcOnL.RecordCount - 1
      
    DynCard(Intindex) = mrcOnL!cardno     '查找第一条记录的卡号
    cardnoo = DynCard(Intindex)     '将查找到的卡号赋值给cardnoo,便于后面SQL查询
      
    txtSQL = "select * from OnLine_Info where cardno='" & Trim(cardnoo) & "'"    '进行表查询
    Set mrc5 = ExecuteSQL(txtSQL, MsgText)
  

    txtSQL = "select * from BasicData_Info "
    Set mrcBas = ExecuteSQL(txtSQL, MsgText)

 '计算上机时长
  intlinetime = (Date - DateValue(mrcOnL!ondate)) * 1440 _
      + (Hour(Time) - Hour(TimeValue(mrcOnL!ontime))) * 60 _
      + (Minute(Time) - Minute(TimeValue(mrcOnL!ontime)))
      

 '计算余额
  If Trim(mrcOnL.Fields(1)) = "临时用户" Then '若为临时用户，计算余额
      Balance = Trim(mrcStu.Fields(0)) - (Int(intlinetime / mrcBas.Fields(2)) + 1) * (Trim(mrcBas.Fields(1)))
  Else '若为固定用户，消费金额的计算
      Balance = Trim(mrcStu.Fields(0)) - (Int(intlinetime / mrcBas.Fields(2)) + 1) * (Trim(mrcBas.Fields(0)))
  End If
  If Val(Balance) > 0 And Val(Balance) <= mrcBas.Fields(5) Then    '如果余额大于0且小于2则给出提醒
        MsgBox DynCard(Intindex) & ",您卡内的金额已不足2元，请尽快充值！", vbOKOnly + vbInformation, "提示"
        mrcc.MoveNext
    End If
    If Balance <= 0 Then    '如果余额小于等于0元，则强制下机
        MsgBox DynCard(Intindex) & ",您卡内金额不足,即将下机", vbOKOnly + vbExclamation, "警告"
        txtcardno.Text = mrcOnL.Fields(0)
        MDIForm1.cmdOffLine = True
  mrcOnL.MoveNext
  mrcStu.MoveNext
      End If
      Next
' Loop
End Sub

大家做机房的时候可以参考我的代码，如有发现比较好的代码，在下面评论。谢谢。