千辛万苦的终于把收费系统做完了，中间真的荒废了很多时间，才导致拖了很长很长时间才完成。这是自己感觉做的第一个项目吧算是，总之还是很有成就感的。从最开始的一头雾水，慢慢的终于理解的算是比较透彻了，对于业务需求的理解也比较通透，还有就是对于数据库的操作也明白了很多。我简单说下比较重要而且有点困难的几个地方。
1.下机结账。本来就是简简单单的对于数据库表的增删改查，但是“基本数据设定”这一个窗体就注定了这儿变得复杂了。
'下机
Private Sub cmdDown_Click()
Dim StartDateTime As Date '定义开始的日期和时间
Dim CardNum As Integer '定义卡号，用来保存上机学生的卡号
Dim EndDateTime As String '定义下机时的日期时间
Dim onLineTime As Double '定义开始上机时间和下机时间之间的间隔
'Dim costRMB As Double '定义用户花费的钱
Dim Balance As Double '定义卡里的余额
Dim maxSerial As Integer '定义下机学生下机表里的序列号
CardNum = Trim(txtCardID.Text)
'给下机时间和日期赋值
EndDate = Format(GetSqlTime, "yyyy/mm/dd")
EndTime = Format(GetSqlTime, "hh:mm:ss")
EndDateTime = Format(GetSqlTime, "yyyy/mm/dd hh:mm:ss")
'保证输入了卡号
If Trim(txtCardID.Text) = "" Then '没有输入卡号，提示
MsgBox "请输入卡号", vbOKOnly + vbExclamation, "警告"
txtCardID.SetFocus
Exit Sub
End If
'输了卡号以后，确保卡号是注册过的
txtSQL = "select * from student_info where cardno='" & CardNum & "'"
Set mrc = ExecuteSQL(txtSQL, msgtext)
If mrc.EOF = True Then
MsgBox "卡号不存在", vbOKOnly + vbExclamation, "提示"
txtCardID.Text = ""
txtCardID.SetFocus
mrc.Close
Exit Sub
End If
'判断此卡是否已经下机或未上机
txtSQL = "select * from online_info where cardno='" & CardNum & "'"
Set mrcOnline = ExecuteSQL(txtSQL, msgtext)
If mrcOnline.BOF = True And mrcOnline.EOF = True Then
MsgBox "此卡未上机或已下机"
txtCardID.Text = ""
Exit Sub
Else
'从学生在线的表里面删除该学生
SQL = "delete from online_info where cardno='" & CardNum & "'"
Call ExecuteSQL(SQL, msgtext)
'计算上机的消费金额，总的余额减去消费金额，将数据更新到student_info中,信息更新到line表中
'然后找到line表中，上机时填入的那一行，因为可能有很多行，所以，我们用序列号和卡号来寻找唯一确定记录
SQL = "select MAX(serial) from line_info where cardno='" & CardNum & "'"
Set mrcLine = ExecuteSQL(SQL, msgtext)
maxSerial = mrcLine.Fields(0)
'计算上机时间，然后根据上机时间，计算出花费的金额，并在student表里面，扣除相应的金额
SQL = "select * from line_info where cardno='" & CardNum & "'and serial='" & maxSerial & "'" '根据卡号和序列号提取上机日期时间
Set mrcLine1 = ExecuteSQL(SQL, msgtext) '查询
StartTime = mrcLine1.Fields(7) '上机时间
onLineTime = DateDiff("n", StartTime, EndTime) '计算时间间隔
'查询basicdate表中的记录
txtSQL = "select * from basicdata_info"
Set mrcBsc = ExecuteSQL(txtSQL, msgtext)
MinTime = mrcBsc.Fields(3) ' 将基本数据表中的最低消费时间赋给mintime
LeastRMB = mrcBsc.Fields(5) '将基本数据表中的最低消费金额赋给leastrmb
ReadyTime = mrcBsc.Fields(4) '将基本数据表的准备时间赋给readytime
UnitTime = mrcBsc.Fields(2) '递增（单位）时间
Rate = mrcBsc.Fields(0) '每个小时消费的金额
'判断用户下机时，处于哪个时间段里面
If onLineTime >= ReadyTime + MinTime Then '如果时间大于（准备时间+至少上机时间）
costRMB = (Int(Val((onLineTime - ReadyTime - MinTime) / UnitTime)) + 1) * Rate * (UnitTime / 60) + 1 '计算花费多少钱
ElseIf ReadyTime < onLineTime Then '如果上机时间在准备时间和至少上机时间之间
costRMB = 1 '只减去至少上机时间花费的钱
Else '还没过准备时间就下机的情况
costRMB = 0 '不扣钱
End If
'先从表中取出余额
SQL = "select * from student_info where cardno='" & CardNum & "'"
Set mrc = ExecuteSQL(SQL, msgtext)
Balance = mrc.Fields(7) '取出余额
'然后将减去花费,设置花费大于0时才更新，这样可以去掉基本数据设置混乱时出现的花费为负值的情况
If costRMB >= 0 Then
Balance = Balance - costRMB
'然后更新student表中余额
SQL = "update student_info set cash=" & Balance & " where cardno='" & CardNum & "'"
Call ExecuteSQL(SQL, msgtext)
End If
End If
'添加到line表中，记录该卡的上机记录
txtSQL = "update line_info set offdate='" & EndDate & "',offtime='" & EndTime & "',consumetime='" & onLineTime & "',consume='" & costRMB & "',cash='" & Balance & "',status='正常下机' where serial='" & maxSerial & "'"
Call ExecuteSQL(txtSQL, msgtext)
'文本框显示信息
SQL = "select * from line_info where serial='" & maxSerial & "'"
Set mrc = ExecuteSQL(SQL, msgtext)
txtSID.Text = Trim(mrc.Fields(2))
txtMajor.Text = Trim(mrc.Fields(4))
txtType.Text = "使用"
txtName.Text = Trim(mrc.Fields(3))
txtSex.Text = Trim(mrc.Fields(5))
'txtSQL = "select * from line_info where cardno='" & CardNum & "'and serial='" & maxSerial & "'" '根据卡号和序列号提取上机日期时间
'Set mrcLine2 = ExecuteSQL(txtSQL, msgText) '查询
'txtSJdate.Text = Trim(mrcLine2.Fields(8))
'txtSJtime.Text = Trim(mrcLine2.Fields(9))
' txtSJdate.Text = StartDate
txtSJtime.Text = StartTime
txtConsumeTime.Text = onLineTime '上机时长
txtConsumeBalance.Text = costRMB '消费金额
txtXJdate.Text = EndDate '下机日期
txtXJtime.Text = EndTime '下机时间
txtBalance.Text = Balance '余额
MsgBox "下机成功"
End Sub2.查看上机状态并选中下机或者强制所有人下机。
'所有正在上机的同学强制下机
Private Sub AllXJ_Click() '所有学生下机按钮 '问题：下机时自动结算余额
Dim IndexStuNum As Integer '定义有多少个上机的学生
Dim a() As Integer '定义数组a用来保存卡号
Dim Index As Integer '数据库中的序列号
Dim i As Integer
Dim Mrcc As ADODB.Recordset
Dim Rst As ADODB.Recordset
Dim SQL As String
Dim strMsg As String
Dim Balance As Integer
'清空表结构
MSHFlexGrid1.ClearStructure
'然后将学生的下机信息写入到学生上机表里，这里主要是写入上下机时间
'在删除之前先判断表中是否有记录
SQL = "select * from online_info" '选中表中所有记录
Set Rst = ExecuteSQL(SQL, strMsg)
If Rst.RecordCount = 0 Then
MsgBox "没人在上机！", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else
'写下机信息
'读取online表，然后从中读出上机学生的卡号
SQL = "select count(*) from online_info"
Set Rst = ExecuteSQL(SQL, strMsg)
IndexStuNum = Trim(Rst.Fields(0)) '获得上机学生的人数
ReDim a(IndexStuNum)
SQL = "select cardno from online_info" '获得所有上机的学生
Set Mrcc = ExecuteSQL(SQL, strMsg)
Mrcc.MoveFirst
For i = 0 To IndexStuNum - 1 '循环每一个学生,然后将获得学生的卡号，然后将卡号赋值给数组
a(i) = Trim(Mrcc!cardno)
If Mrcc.EOF Then
Exit For
End If
Mrcc.MoveNext
'计算上机的消费金额，总的余额减去消费金额，将数据更新到student_info中
'给下机时间和日期赋值
EndDate = Format(GetSqlTime, "yyyy/mm/dd")
EndTime = Format(GetSqlTime, "hh:mm:ss")
SQL = "select max(serial) from line_info where cardno='" & a(i) & "'"
Set Rst = ExecuteSQL(SQL, strMsg)
'读出序列号
Index = Trim(Rst.Fields(0))
'再向学生上机信息表里面，填入下机日期，下机时间
SQL = "update line_info set offdate='" & Format(GetSqlTime, "yyyy/mm/dd") & "',offtime='" & Format(GetSqlTime, "hh:mm:ss") & "', where serial='" & Index & "'"
Set Rst = ExecuteSQL(SQL, strMsg) '执行插入
'计算上机时间，然后根据上机时间，计算出花费的金额，并在学生基本信息表里面，扣除相应的金额
SQL = "select * from line_info where serial='" & Index & "'" '根据卡号和序列号提取上机日期时间
Set Rst = ExecuteSQL(SQL, strMsg) '查询
StartTime = Rst.Fields(7)
onLineTime = DateDiff("n", StartTime, EndTime) '计算时间间隔
'查询basicdate表中的记录
txtSQL = "select * from basicdata_info"
Set mrcBsc = ExecuteSQL(txtSQL, msgtext)
MinTime = mrcBsc.Fields(3) ' 将基本数据表中的最低消费时间赋给mintime
LeastRMB = mrcBsc.Fields(5) '将基本数据表中的最低消费金额赋给leastrmb
ReadyTime = mrcBsc.Fields(4) '将基本数据表的准备时间赋给readytime
UnitTime = mrcBsc.Fields(2) '递增（单位）时间
Rate = mrcBsc.Fields(0) '每个小时消费的金额
'判断用户下机时，处于哪个时间段里面
If onLineTime >= ReadyTime + MinTime Then '如果时间大于（准备时间+至少上机时间）
costRMB = (Int(Val((onLineTime - ReadyTime - MinTime) / UnitTime)) + 1) * Rate * (UnitTime / 60) + 1 '计算花费多少钱
ElseIf ReadyTime < onLineTime Then '如果上机时间在准备时间和至少上机时间之间
costRMB = 1 '只减去至少上机时间花费的钱
Else '还没过准备时间就下机的情况
costRMB = 0 '不扣钱
End If
'先从表中取出余额
SQL = "select * from student_info where cardno='" & a(i) & "'"
Set Rst = ExecuteSQL(SQL, strMsg)
Balance = Rst.Fields(7) '取出余额
'然后将减去花费,设置花费大于0时才更新，这样可以去掉基本数据设置混乱时出现的花费为负值的情况
If costRMB >= 0 Then
Balance = Balance - costRMB
'然后更余额
SQL = "update student_info set cash=" & Balance & " where cardno='" & a(i) & "'"
Call ExecuteSQL(SQL, strMsg)
End If
'写入line表里面，更新里面的消费金额
SQL = "update line_info set offdate='" & EndDate & "',offtime='" & EndTime & "',consumetime='" & onLineTime & "',consume='" & costRMB & "',cash=" & Balance & ",status='正常下机' where serial='" & Index & "'"
'SQL = "update line_info set consume='" & costRMB & "',consumetime='" & onLineTime & "' where serial='" & Index & "'"
Call ExecuteSQL(SQL, strMsg)
Next i
SQL = "delete from online_info" '删除学生上机表中的所有记录
Call ExecuteSQL(SQL, strMsg)
End If
End Sub下面是选中下机。只有删除记录部分，没有展示出结账部分
'确定删除的行号
rowIndex = MSHFlexGrid1.RowSel
'删除数据库中数据
'先判断删除的是否是空行或者是列标题
If MSHFlexGrid1.TextMatrix(MSHFlexGrid1.RowSel, MSHFlexGrid1.ColSel) = "" Or rowIndex = 0 Then
MsgBox "请选中正在上机的学生！", vbOKOnly + vbExclamation, "警告"
Exit Sub
Else '当删除的不是空行时
'删除此行
MSHFlexGrid1.RemoveItem (rowIndex)
delSQL = "delete from online_info where cardno= '" & delUser & "'"
Call ExecuteSQL(delSQL, msgtext) '执行查询3.结账，以及导入到日结账单。
管理员—结账部分，就是把一天的收入计算汇总并添加到checkday表中。收入包括今天所有人注册时的初始金额，加上今天所有人充值金额，加上今天所有人上机消费，减去今天所有人的退卡金额，就是总收入：allMoney = registerMoney + rechargeMoney - cancelMoney。还要判断是不是唯一一次结账，保证每次点击结账按钮后，checkday表中总是有今天唯一的记录。
结账部分：
Private Sub setacont_Click() '结账模块，将记录全部写到checkday表中
'判断今天是否已经结果账了
strSQL = "select * from checkday_info where date='" & Format(Date, "yyyy/mm/dd") & "'" '从日结账单表里选择今天的结账记录
Set mrc = ExecuteSQL(strSQL, msgtext)
If Not (mrc.BOF And mrc.EOF) Then '今天已经结过账了，即，这不是今天第一次结账
'先删除今天结过的账单
strSQL = "delete from checkday_info where date='" & Format(Date, "yyyy/mm/dd") & "'"
Call ExecuteSQL(strSQL, msgtext)
'先删除今天结过的账单
strSQL = "delete from checkweek_info where date='" & Format(Date, "yyyy/mm/dd") & "'"
Call ExecuteSQL(strSQL, msgtext)
'插入记录到checkday表中
strSQL = "insert into checkday_info values('" & registerMoney & "','" & rechargeMoney & "','" & costRMB & "','" & cancelMoney & "','" & allMoney & "','" & Format(Date, "yyyy/mm/dd") & "')"
Call ExecuteSQL(strSQL, msgtext)
'插入记录到checkweek表中
strSQL = "insert into checkweek_info values('" & registerMoney & "','" & rechargeMoney & "','" & costRMB & "','" & cancelMoney & "','" & allMoney & "','" & Format(Date, "yyyy/mm/dd") & "')"
Call ExecuteSQL(strSQL, msgtext)
Else
'插入记录到checkday表中
strSQL = "insert into checkday_info values('" & registerMoney & "','" & rechargeMoney & "','" & costRMB & "','" & cancelMoney & "','" & allMoney & "','" & Format(Date, "yyyy/mm/dd") & "')"
Call ExecuteSQL(strSQL, msgtext)
'插入记录到checkweek表中
strSQL = "insert into checkweek_info values('" & registerMoney & "','" & rechargeMoney & "','" & costRMB & "','" & cancelMoney & "','" & allMoney & "','" & Format(Date, "yyyy/mm/dd") & "')"
Call ExecuteSQL(strSQL, msgtext)
End If
txtSQL = "select * from student_Info where UserId = '" & Trim(cmbUserId.Text) & "' and Ischeck ='未结账' "
Set mrc = ExecuteSQL(txtSQL, msgtext) '购卡模块
Do While mrc.EOF = False
mrc.Fields(11) = "已结账"
mrc.MoveNext '游标移动到下一条记录
Loop
mrc.Close
txtSQL = "select * from Recharge_Info where UserId = '" & Trim(cmbUserId.Text) & "' and status ='未结账'"
Set mrc = ExecuteSQL(txtSQL, msgtext) '充值模块
Do While mrc.EOF = False
mrc.Fields(7) = "已结账"
mrc.MoveNext '游标移动到下一条记录
Loop
mrc.Close
txtSQL = "select * from CancelCard_Info where UserId = '" & Trim(cmbUserId.Text) & "' and status = '未结账' "
Set mrc = ExecuteSQL(txtSQL, msgtext) '退卡模块
Do While mrc.EOF = False
mrc.Fields(6) = "已结账"
mrc.MoveNext '游标移动到下一条记录
Loop
mrc.Close
'清空所有记录
txtNumSaleCard.Text = 0
txtSumExitCard.Text = 0
txtRcgSum.Text = 0
txtCllSum.Text = 0
txtExitCardSum.Text = 0
txtSumCard.Text = 0
txtAllSum.Text = 0
MsgBox "您已经成功结账。", vbOKOnly + vbExclamation, "提示"
End Sub
Private Sub Form_Load()
Dim s As String
txtSQL = "select * from CheckDay_Info where date = '" & Format(Date, "yyyy/mm/dd") & "' "
Set report = New grproLibCtl.GridppReport
'实例化报表
report.LoadFromFile (App.Path & "\机房收入日汇总表.grf")
'载入报表模板
report.DetailGrid.Recordset.QuerySQL = txtSQL
'通过select语句查询创建记录集
Set mrc = ExecuteSQL(txtSQL, msgtext)
report.DetailGrid.Recordset.ConnectionString = "provider=sqloledb;server=**.**.**.**;database=charge_sys;uid=sa;pwd=123456;"
GRDisplayViewer1.report = report
'设置报表查询器显示控件的关联报表对象
GRDisplayViewer1.Start
'启动报表运行
Me.Height = 7500
Me.Width = 10500
End Sub
注意连接的地址要是服务器的地址，并且在之前设计报表的时候就要把连接填成服务器地址，否则无法异地发布。
以上就是我感觉整个系统比较重要的地方，其他的都是一些查询，熟练了都很简单。从刚开始的对整个系统的恐惧到现在感觉它也没有多难，这就是学习的过程，所以，在以后的学习中不要怕困难，仅仅要做的就是just do it。等一切都完了的时候回头看看才发现，原来这一切都很简单。
扫一扫
265
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
