機房收費系統之動態重新整理下機

在網咖上網,卡里沒錢就要系統強制下機.怎麼辦?

這是我用到timer1控制項,

timer1重要的屬性是interval.但lnterval有範圍限制,不過我可以通過函式來調節大小.在這裡不用,你可以隨便什麼時候重新整理.

我還用到動態陣列redim

redim :在有些時候不知道需要多大的陣列，就可以使用乙個能改變大小的陣列，就是動態陣列，redim是很方便，靈活的可以隨時改變大小的陣列。有效管理記憶體，可以將記憶體空間釋放給系統，大大節省記憶體，提高執行速度。

private sub timer1_timer()

dim i, cardno as integer
dim txtsql, msgtext as string
dim mrcba, mrcon, mrc1, mrcstudent as adodb.recordset
dim intconsumetime, cmoney, newcash, pastcash, fixusercharge, temusercharge as integer
txtsql = "select * from basicdata_info"
set mrcba = executesql(txtsql, msgtext)
txtsql = "select * from student_info"
set mrcstudent = executesql(txtsql, msgtext)
txtsql = "select * from 0nline_info"
set mrcon = executesql(txtsql, msgtext)
txtsql = "select * from line_info"
set mrc1 = executesql(txtsql, msgtext)
'當online表沒有資料時直接跳出此過程
if mrcon.eof and mrcon.bof then
timer1.enabled = false
exit sub
end if
fixusercharge = mrcba.fields(0) '固定使用者的單位費用
temusercharge = mrcba.fields(1) '臨時使用者的單位費用
pastcash = mrcstudent.fields(7) '獲得原金額
'將上機卡號定義為乙個陣列
redim a(mrcon.recordcount) as string
for i = 0 to mrcon.recordcount - 1
a(i) = trim(mrcon!cardno)
cardno = a(i)
txtsql = "select * from online_info where cardno='" & trim(cardno) & "'"
set mrcon = executesql(txtsql, msgtext)
intconsumetime = datediff("n", mrcon.fields(10), now) '計算時間
if mrcon!card = "固定使用者" then
cmoney = int(intconsumetime / 60 + 1) * fixusercharge
newcash = pastcash - cmoney
'判斷金額是否充足
if (newcash > 0) and (newcash <= val(mrcba!limitcash)) or (newcash < 0) then
txtsql = "delete * from online_info where cardno = '" & cardno & "'"
set mrcon = executesql(txtsql, msgtext)
msgbox "卡號：" & cardno & ",餘額不足，即將下機！", 48, "警告"
mrcstudent!cash = newcash
mrcstudent.update
txtconsume.text = cmoney
txtcash.text = newcash
call viewdata
exit sub
end if
else
cmoney = int(intconsumetime / 60 + 1) * temusercharge
newcash = pastcash - cmoney
'判斷金額是否充足
if (newcash > 0) and (newcash <= val(mrcba!limitcash)) or (newcash < 0) then
txtsql = "delete * from online_info where cardno = '" & cardno & "'"
set mrcon = executesql(txtsql, msgtext)
msgbox "卡號：" & cardno & ",餘額不足，即將下機！", 48, "警告"
mrcstudent!cash = newcash
mrcstudent.update
txtconsume.text = cmoney
txtcash.text = newcash
call viewdata
exit sub
end if
end if
end sub
private sub viewdata()
txtcardno.text = mrc1.fields(0)
txtstudentno.text = mrc1!studentno
txtdepartment.text = mrc1!department
txttype.text = mrc1!type
txtname.text = mrc1!studentname
txt***.text = mrc1!***
txtondate.text = mrc1!ondate
txtontime.text = mrc1!ontime
txtoffdate.text = date
txtofftiem.text = time
txtconsumetime.text = intconsumetime
mrc1!offdate = date
mrc1!offtime = time
mrc1!consumetime = intconsumetime
mrc1.update
end sub

機房收費系統 下機

有了上機的思路，下機當然也就很簡單了，不過總是要比別人多想一步，這樣你就能夠比別人更加的優秀。下機的流程圖 下機的注意事項 txtontime.text trim mrc3.fields 7 txtdowndate.text format now yyyy mm dd txtdowntime.tex...

機房收費系統 下機

上下機是機房收費系統中比較重要的一部分，所以我們一定要把上下機的思路理清楚才可以，不然會很亂，一會兒就把自己繞進去了，現在我們一起分析一下下機的思路吧！片段 判斷上下機的情況 private sub cmdoffline click dim mrconline as adodb.recordset ...

機房收費系統 下機

計算消費時間 計算上機時間 intlinetime date datevalue onw ondate 1440 hour time hour timevalue onw ontime 60 minute time minute timevalue onw ontime 計算機上機時間 txtcti...