機房收費系統下機之動態顯示餘額和強制下機 2

2021-09-29 19:34:53 字數 4458 閱讀 8929

機房收費系統下機之動態顯示餘額和強制下機(1)

封裝下機**

public function offline(cardno as string)

dim mrcline as adodb.recordset

dim mrcbasic as adodb.recordset

dim mrccash as adodb.recordset

dim mrcupdate as adodb.recordset

dim mrc as adodb.recordset

dim txtsql, msgtext as string

dim alltime as integer

'下機時間

txtofflinedate.text = now()

'查詢上機表

txtsql = "select * from line_info where cardno='" & username & "' and status='上機中'"

set mrcline = executesql(txtsql, msgtext)

'計算上機時間

alltime = fix(datediff("n", mrcline!ondatetime, now()))

txttime.text = alltime

'查詢基礎資料表

txtsql = "select * from basicdata_info"

set mrcbasic = executesql(txtsql, msgtext)

'判斷是否超過準備時間

if alltime < mrcbasic!leasttime then

txtcash.text = "0.00"

else

'根據使用者型別計算每15分鐘的花費

if trim(mrcline!cardtype) = "固定使用者" then

unitmoney = format(1 / 4 * val(mrcbasic!rate), "0.00")

else

unitmoney = format(1 / 4 * val(mrcbasic!tmprate), "0.00")

end if

'不是十五的整倍數的進1,按照十五進行計算

if alltime mod 15 = 0 then

'判斷使用者型別而收費

if trim(mrcline!cardtype) = "固定使用者" then

costmoney = format(alltime / 15 * unitmoney, "0.00")

else

costmoney = format(alltime / 15 * unitmoney, "0.00")

end if

else

'判斷使用者型別而收費

if trim(mrcline!cardtype) = "固定使用者" then

costmoney = format((fix(alltime / 15) + 1) * unitmoney, "0.00")

else

costmoney = format((fix(alltime / 15) + 1) * unitmoney, "0.00")

end if

end if

'計算餘額

txtsql = "select * from card_info where cardno='" & username & "'"

set mrccash = executesql(txtsql, msgtext)

txtbalance.text = format(mrccash!cash - costmoney) '顯示餘額

txtcash.text = format(costmoney, "0.00") '顯示消費金額

end if

'更新上下機表

txtsql = "update line_info set offdatetime='" & trim(txtofflinedate.text) & "',consumetime='" & trim(txttime.text) & _

"',consume='" & trim(txtcash.text) & "',cash='" & trim(txtbalance.text) & "',status='已下機' where cardno='" & username & "' and status='上機中'"

set mrc = executesql(txtsql, msgtext)

'更新卡號表

txtsql = "update card_info set cash='" & trim(txtbalance.text) & "' where cardno='" & username & "'"

set mrc = executesql(txtsql, msgtext)

msgbox "下機成功!", 0 + 48, 提示

frmcommonuser.hide

flogin.show

end function

呼叫下機**

private sub cmdoffline_click()

call offline(username)

end sub

動態計費和強制下機

private sub timer2_timer()

dim mrcline as adodb.recordset

dim mrcbasic as adodb.recordset

dim mrccash as adodb.recordset

dim txtsql as string

dim msgtext as string

dim alltime as integer

'查詢上機表

txtsql = "select * from line_info where cardno='" & username & "' and status='上機中'"

set mrcline = executesql(txtsql, msgtext)

'計算上機時間

alltime = fix(datediff("n", mrcline!ondatetime, now()))

txttime.text = alltime

'查詢基礎資料表

txtsql = "select * from basicdata_info"

set mrcbasic = executesql(txtsql, msgtext)

'根據使用者型別計算每15分鐘的花費,使用者後面的動態餘額計算

if trim(mrcline!cardtype) = "固定使用者" then

unitmoney = format(1 / 4 * val(mrcbasic!rate), "0.00")

else

unitmoney = format(1 / 4 * val(mrcbasic!tmprate), "0.00")

end if

'每隔15分鐘進行一次計費

if alltime mod 15 = 0 then

'判斷使用者型別而計費

if trim(mrcline!cardtype) = "固定使用者" then

costmoney = format(alltime / 15 * unitmoney, "0.00")

else

costmoney = format(alltime / 15 * unitmoney, "0.00")

end if

'動態計算餘額

txtsql = "select * from card_info where cardno='" & username & "'"

set mrccash = executesql(txtsql, msgtext)

txtbalance.text = format(txtbalance.text - unitmoney, "0.00") '動態顯示桌面餘額

txtcash.text = format(costmoney, "0.00") '動態顯示桌面計費

if val(txtbalance.text) <= unitmoney then

msgbox "卡號:" & username & ",餘額不足,即將下機", 0 + 48, "提示"

'呼叫下機**

call offline(username)

exit sub

end if

'判斷餘額是否低於最低充值要求

if val(txtbalance.text) <= unitmoeny + 1 then

msgbox "卡號:" & username & ",餘額不足,請先充值!", 0 + 48, "提示"

end if

end if

end sub

機房收費系統下機之動態顯示餘額和強制下機(1)

優化 在做下機的時候,要考慮到強制下機的問題,如果我卡裡面只有30元,卻玩了40元的,那麼在下機餘額就是負的了,這時候再去充值就不合理了,所以我加了乙個動態顯示餘額和強制下機的功能,我的動態計算是15分鐘計算一次的,涉及到小數點,一分鐘扣除一次誤差可能比較大,所以就以15作為一次扣費單位 思路動態顯...

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

在網咖上網,卡里沒錢就要系統強制下機.怎麼辦?這是我用到timer1控制項,timer1重要的屬性是interval.但lnterval有範圍限制,不過我可以通過函式來調節大小.在這裡不用,你可以隨便什麼時候重新整理.我還用到動態陣列redim redim 在有些時候不知道需要多大的陣列,就可以使用...

機房收費系統 下機

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