机房收费系统——函数

在机房收费系统中涉及到的一些函数有下面，通过函数提高程序运行，编程的效率。适合多次重复使用的公共对象。下面比较复杂的要数第一个消费金额函数，但实际上就是小数学水平；使用频率比较多的是第三个执行数据库的函数，它贯穿这个系统编程的始终；最多的就是第四个判断文本框内容是否为空。

一、         消费金额函数：

 

'消费金额的计算
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 Long
Public Function getPcName()         '该函数返回计算机名称
   Dim Name As String, Length As Long
   Length = 255
   Name = String(Length, 0)
   GetComputerName Name, Length
   Name = Left(Name, Length)
   getPcName = Name
End 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