機房收費系統——函數

 

'消費金額的計算Public Function Consume(consumeTime As Long, Money As Long)    '儲存基本資料設定資訊    Dim leastTime As Long ‘定義至少上機時間    Dim UnitTime As Long’定義單位遞增時間    Dim preTime As Long’定義準備時間    Dim rateMoeny As Long’定義固定單位時間的費用    Dim limitCash As Long’定義最少金額            Dim mrc As ADODB.Recordset '定義臨時記錄集    Dim MsgText As String '定義字串    Dim txtSQL As String '定義查詢條件字串        '讀取設定基本資料資訊    txtSQL = "select * from basicdata_info"    Set mrc = ExecuteSQL(txtSQL, MsgText)    mrc.MoveLast    rateMoeny = mrc.Fields(0)    'txtLh.text=mrc.fields(1)    UnitTime = mrc.Fields(2)    leastTime = mrc.Fields(3)    preTime = mrc.Fields(4)    limitCash = mrc.Fields(5)    mrc.Close    '消費時間最少為設定值    If consumeTime < leastTime Then        consumeTime = leastTime    End If    '消費函數       Money = Int(Int(consumeTime - preTime) / UnitTime + 1) * (rateMoeny / 30 * UnitTime)    Consume = Money   End Function

   

       

  PublicDeclare Function GetComputerName Lib "kernel32" Alias"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As LongPublic Function getPcName()         '該函數返回電腦名稱   Dim Name As String, Length As Long   Length = 255   Name = String(Length, 0)   GetComputerName Name, Length   Name = Left(Name, Length)   getPcName = NameEnd Function

       

  PublicFunction ExecuteSQL(ByVal SQL As String, MsgString As String) AsADODB.Recordset 'executes SQL and returns Recordest   Dim cnn As ADODB.Connection   Dim rst As ADODB.Recordset   Dim sTokens() As String      On Error GoTo executeSQL_Error      sTokens = Split(SQL)   Set cnn = New ADODB.Connection   cnn.Open ConnectString      If InStr("insert,delete,update", UCase$(sTokens(0))) Then '非select 語句    '函數返回字元或字串在另一個字串中第一次出現的位置       cnn.Execute SQL  '資料量不大時，可以在串連上，直接執行SQL語句       MsgString = sTokens(0) & "query successful"       '雖然Msgstring不是返回值，但傳遞方式是ByRef,實參地址和這個地址相同   Else     Set rst = New ADODB.Recordset         rst.Open Trim$(SQL), cnn, adOpenKeyset, adLockOptimistic     '得到暫存資料表，遊標指向第一條記錄     'get recordCount,     Set ExecuteSQL = rst     MsgString = "查詢到" & rst.RecordCount & _           "條記錄"   End If   executeSQL_Exit:   Set rst = Nothing   Set cnn = Nothing    Exit Function   executeSQL_Error:   MsgString = "查詢錯誤：" & Err.Description     '對錯誤進行簡短描述。當無法處理或不想處理錯誤的時候，可以使用這個屬性提醒使用者。     Resume executeSQL_Exit '啟動一個錯誤處理程式並指定該子程式在一個過程中的位置    End Function

Public Function Testtxt(txt As String) AsBoolean   If Trim(txt) = "" Then       Testtxt = False   Else       Testtxt = True    End If   End Function