机房收费系统问题集（6）——上、下机

    哈哈，机房收费系统基本上敲完了，现在分享一下上下机的知识吧！！！

    刚开始敲上下机的时候，思维有点混乱，其实弄明白表与表之间的关系，心里有”卡号“这一条主线，就会清晰好多......

首先是上机：

<span style="font-family:KaiTi_GB2312;font-size:18px;"><strong><span style="font-family:KaiTi_GB2312;font-size:18px;"><strong>Private Sub shangji_Click()
    Dim txtsql1 As String
    Dim txtsql2 As String
    Dim txtsql3 As String
    Dim txtsql4 As String
    
    Dim msgtext1 As String
    Dim msgtext2 As String
    Dim msgtext3 As String
    Dim msgtext4 As String
    
    Dim mrc1 As ADODB.Recordset
    Dim mrc2 As ADODB.Recordset
    Dim mrc3 As ADODB.Recordset
    Dim mrc4 As ADODB.Recordset
    
    Dim leastmoney As Long
    
    txtoffdate.Text = ""
    txtofftime.Text = ""
    txtconsume.Text = ""
    txtconsumetime.Text = ""
    
    '判断卡号是否为空
    If testtxt(txtcardno.Text) = False Then
       MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "警告"
       txtcardno.SetFocus
       Exit Sub
    End If
    Set mrc1 = New ADODB.Recordset
    txtsql1 = "select * from student_Info where cardno='" & txtcardno.Text & "'"
    Set mrc1 = executesql(txtsql1, msgtext1)
    '判断该卡是否存在
    If mrc1.EOF And mrc1.BOF Then
       MsgBox "该卡号未注册！", vbOKOnly + vbExclamation, "提示"
       txtcardno.Text = ""
       txtcardno.SetFocus
       Exit Sub
    Else
    '判断余额是否充足
       Set mrc4 = New ADODB.Recordset
       txtsql4 = "select * from BasicData_Info "
       Set mrc4 = executesql(txtsql4, msgtext4)
       leastmoney = mrc4.Fields(5)
       If mrc1.Fields(7) < leastmoney Then
          MsgBox "余额只有" & mrc1.Fields(7) & "，少于最少金额，请充值后再上机！", vbOKOnly, "提示"
          Exit Sub
          mrc4.Close
       Else
    '判断该卡号是否正在上机
         Set mrc2 = New ADODB.Recordset
         txtsql2 = "select * from OnLine_Info where cardno='" & txtcardno.Text & "'"
         Set mrc2 = executesql(txtsql2, msgtext2)
        If Not (mrc2.EOF And mrc2.BOF) Then
           MsgBox "该卡正在上机！", vbOKOnly, "提示"
           txtcardno.Text = ""
           txtcardno.SetFocus
           Exit Sub
        Else
           txtcardno.Text = Trim(mrc1.Fields(0))
           txtstudentno.Text = Trim(mrc1.Fields(1))
           txtstudentname.Text = Trim(mrc1.Fields(2))
           txttype.Text = Trim(mrc1.Fields(14))
           txtsex.Text = Trim(mrc1.Fields(3))
           txtdepartment.Text = Trim(mrc1.Fields(4))
           txtondate.Text = Date
           txtontime.Text = Time
           txtcash.Text = Trim(mrc1.Fields(7))
           
           '将上机的信息添加到OnLine_Info表中
           Set mrc3 = New ADODB.Recordset
           txtsql3 = "select * from OnLine_Info "
           Set mrc3 = executesql(txtsql3, msgtext3)
           mrc3.AddNew
           mrc3.Fields(0) = Trim(txtcardno.Text)
           mrc3.Fields(1) = Trim(txttype.Text)
           mrc3.Fields(2) = Trim(txtstudentno.Text)
           mrc3.Fields(3) = Trim(txtstudentname.Text)
           mrc3.Fields(4) = Trim(txtdepartment.Text)
           mrc3.Fields(5) = Trim(txtsex.Text)
           mrc3.Fields(6) = Trim(txtondate.Text)
           mrc3.Fields(7) = Trim(txtontime.Text)
           mrc3.Fields(8) = Trim(Winsock1.LocalHostName)
           mrc3.Update
           '显示此时上机的人数
           Label13.Caption = mrc3.RecordCount
           
           mrc3.Close
           mrc2.Close
        End If
    End If
End If
End Sub
</strong></span></strong></span>

其次是下机：

<span style="font-family:KaiTi_GB2312;font-size:18px;"><strong><span style="font-family:KaiTi_GB2312;font-size:18px;"><strong>Private Sub xiaji_Click()
    Dim txtsql1 As String
    Dim txtsql2 As String
    Dim txtsql3 As String
    Dim txtsql4 As String
    
    Dim msgtext1 As String
    Dim msgtext2 As String
    Dim msgtext3 As String
    Dim msgtext4 As String
    
    Dim mrc1 As ADODB.Recordset
    Dim mrc2 As ADODB.Recordset
    Dim mrc3 As ADODB.Recordset
    Dim mrc4 As ADODB.Recordset
    
    Dim leasttime As String
    Dim OldCash As String
    Dim NewCash As String
    Dim StrType As String
    Dim StartTime As String
    Dim EndTime As String
    Dim Inttime As Integer
    Dim StrRate As Integer
    Dim consume As Integer
    
    If testtxt(txtcardno.Text) = False Then
       MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "提示"
       txtcardno.Text = ""
       txtcardno.SetFocus
       Exit Sub
    End If
   '判断该卡号是否注册
   Set mrc1 = New ADODB.Recordset
   txtsql1 = "select * from student_Info where cardno='" & txtcardno.Text & "'"
   Set mrc1 = executesql(txtsql1, msgtext1)
   If mrc1.EOF And mrc1.BOF Then
      MsgBox "该卡号未注册！", vbOKOnly + vbExclamation, "提示"
      txtcardno.Text = ""
      txtcardno.SetFocus
      Exit Sub
   Else
  '判断该卡号是否上机
      Set mrc2 = New ADODB.Recordset
      txtsql2 = "select * from OnLine_Info where cardno='" & txtcardno.Text & "'"
      Set mrc2 = executesql(txtsql2, msgtext2)
      If mrc2.EOF And mrc2.BOF Then
         MsgBox "该卡号没有上机！", vbOKOnly + vbExclamation, "提示"
         txtcardno.Text = ""
         txtcardno.SetFocus
         Exit Sub
      Else
         txtcardno.Text = Trim(mrc2.Fields(0))
         txttype.Text = Trim(mrc2.Fields(1))
         txtstudentno.Text = Trim(mrc2.Fields(2))
         txtstudentname.Text = Trim(mrc2.Fields(3))
         txtdepartment.Text = Trim(mrc2.Fields(4))
         txtsex.Text = Trim(mrc2.Fields(5))
         txtondate.Text = Trim(mrc2.Fields(6))
         txtontime.Text = Trim(mrc2.Fields(7))
         txtoffdate.Text = Date
         txtofftime.Text = Time
      
      '计算消费时间
      StartTime = Format(mrc2.Fields(7), "hh:mm:ss")
      EndTime = Format(Time, "hh:mm:ss")
      txtconsumetime.Text = DateDiff("n", Trim(StartTime), Trim(EndTime))
      
      '计算消费金额
      StrType = Trim(mrc1.Fields(14)) '获取用户类型，用于判断单位价格
      OldCash = Val(mrc1.Fields(7)) '获取用户余额
      
      '在basicdata表中获取基本数据
      txtsql3 = "select * from BasicData_Info "
      Set mrc3 = executesql(txtsql3, msgtext3)
      leasttime = Trim(mrc3.Fields(3))
      
      Select Case StrType
      Case "固定用户"
         StrRate = Val(Trim(mrc3.Fields(0)))
      Case "临时用户"
         StrRate = Val(Trim(mrc3.Fields(1)))
      End Select
     
      
      If Val(Trim(txtconsumetime.Text)) < leasttime Then
         NewCash = OldCash
         txtconsume.Text = "0.0"
        
      Else
         If Val(Trim(txtconsumetime.Text)) < 60 And Val(Trim(txtconsumetime.Text)) > leasttime Then
            NewCash = Val(OldCash) - Val(StrRate) * 1
            consume = StrRate
         Else
            Inttime = Int(Val(txtconsumetime.Text) / 60)
            
            NewCash = Val(OldCash) - StrRate * Inttime
            consume = StrRate * Inttime
         End If
            txtconsume.Text = Val(consume) & ".0"
            txtcash.Text = Val(NewCash)
      End If
  End If
'更新student表
txtsql1 = "update student_Info set cash=" & NewCash & " where cardno='" & txtcardno.Text & "'"
Call executesql(txtsql1, msgtext1)

'更新OnLine表
txtsql2 = "delete OnLine_Info where cardno='" & txtcardno.Text & "'"
Call executesql(txtsql2, msgtext2)
txtsql2 = "select * from OnLine_Info "
Set mrc2 = executesql(txtsql2, msgtext2)
Label13.Caption = mrc2.RecordCount '获取新的上机人数

'更新Line表
txtsql4 = "select * from Line_Info"
Set mrc4 = executesql(txtsql4, msgtext4)
mrc4.Fields(1) = Trim(txtcardno.Text)
mrc4.Fields(2) = Trim(txtstudentno.Text)
mrc4.Fields(3) = Trim(txtstudentname.Text)
mrc4.Fields(4) = Trim(txtdepartment.Text)
mrc4.Fields(5) = Trim(txtsex.Text)
mrc4.Fields(6) = Trim(txtondate.Text)
mrc4.Fields(7) = Trim(txtontime.Text)
mrc4.Fields(8) = Trim(txtoffdate.Text)
mrc4.Fields(9) = Trim(txtofftime.Text)
mrc4.Fields(10) = Trim(txtconsumetime.Text)
mrc4.Fields(11) = Trim(txtconsume.Text)
mrc4.Fields(12) = Trim(NewCash)
mrc4.Fields(13) = "正常下机"
mrc4.Fields(14) = Trim(Winsock1.LocalHostName)'获取机器号
mrc4.Update
mrc4.Close

End If
End Sub
</strong></span></strong></span>

我的代码很多，有木有？理解着来就会发现其实也挺简单的。在代码中有一句获取机器号的代码

这个也很简单，首先添加控件：

工程|部件|Microsoft Winsock Control 6.0

添加后是这个按钮：，漂亮吧，和timer控件相似，只有这么大，small baby ，嘿嘿......

然后添加一句代码就OK了！

mrc4.Fields(14) = Trim(Winsock1.LocalHostName)

    上下机就这样被我“无情”的解决掉了，嘿嘿，神清气爽，有木有？小伙伴们，可要加油啦！！！