mdlpublic.bas

自来水公司的一个管理系统

   '修改:
   '修改内容:
   '-------------------------
    Const MIN_ASC = 32  ' Space.
    Const MAX_ASC = 126 ' ~.
    Const NUM_ASC = MAX_ASC - MIN_ASC + 1

    Dim offset As Long
    Dim str_len As Integer
    Dim i As Integer
    Dim ch As Integer
    Dim to_text As String

    ' 初始化随机数
    offset = NumericPassword(password)
    Rnd -1
    Randomize offset

    ' 解密
    str_len = Len(from_text)
    to_text = ""
    For i = 1 To str_len
        ch = Asc(Mid$(from_text, i, 1))
        If ch >= MIN_ASC And ch <= MAX_ASC Then
            ch = ch - MIN_ASC
            offset = Int((NUM_ASC + 1) * Rnd)
            ch = ((ch - offset) Mod NUM_ASC)
            If ch < 0 Then ch = ch + NUM_ASC
            ch = ch + MIN_ASC
            to_text = to_text & Chr$(ch)
        End If
    Next i
    Decipher = to_text
End Function

Public Function NumericPassword(ByVal password As String) As Long
   '-------------------------
   '功能：  将口令转换为一组数字(该函数是作为上述加密/解密两个函数的辅函数)
   '参数：  password 口令
   '返回值: 对应的一组数字
   '用法:   数字=NumericPassword(口令)
   '建立:   2001/5/07  by pc
   '修改:
   '修改内容:
   '-------------------------
    Dim value As Long
    Dim ch As Long
    Dim shift1 As Long
    Dim shift2 As Long
    Dim i As Integer
    Dim str_len As Integer

    str_len = Len(password)
    For i = 1 To str_len
        ch = Asc(Mid$(password, i, 1))
        value = value Xor (ch * 2 ^ shift1)
        value = value Xor (ch * 2 ^ shift2)

        shift1 = (shift1 + 7) Mod 19
        shift2 = (shift2 + 13) Mod 23
    Next i
    NumericPassword = value
End Function

Public Function CreateWaterRateNotify() As Boolean
    '-------------------------
    '功能：  生成水费催交通知单临时表(表名为全局公有常量gWaterRateNotify)
    '参数：
    '返回值: TRUE 创建成功  ；FALSE 创建失败
    '用法:
    '建立:   2001/6/02  by pc
    '修改:
    '修改内容:
    '-------------------------
    Dim strSQL As String
    
    strSQL = "CREATE TABLE " & gWaterRateNotify & "([UID] [char] (5) NOT NULL ,[PmWaterRead] [decimal](18, 2) NULL,[WaterRevise] [decimal](18, 2) NULL)"
    On Error GoTo ErrHandleExe
    gConnect.Execute strSQL
    On Error GoTo 0
    CreateWaterRateNotify = True
    Exit Function
ErrHandleExe:
    CreateWaterRateNotify = False
    On Error GoTo 0
End Function

Public Function DeleteWaterRateNotify() As Boolean
    '-------------------------
    '功能：  删除水费催交通知单临时表(表名为全局公有常量gWaterRateNotify)
    '参数：
    '返回值: TRUE 删除成功  ；FALSE 删除失败
    '用法:
    '建立:   2001/6/02  by pc
    '修改:
    '修改内容:
    '-------------------------
    Dim strSQL As String
    
    strSQL = "DROP TABLE " & gWaterRateNotify
    On Error GoTo ErrHandleExe
    gConnect.Execute strSQL
    On Error GoTo 0
    DeleteWaterRateNotify = True
    Exit Function
ErrHandleExe:
    DeleteWaterRateNotify = False
    On Error GoTo 0
End Function

Public Function CreateWaterRateCount() As Boolean
    '-------------------------
    '功能：  生成水费计算临时表(表名为全局公有常量gWaterRate)
    '参数：
    '返回值: TRUE 创建成功  ；FALSE 创建失败
    '用法:
    '建立:   2001/6/15  by pc
    '修改:
    '修改内容:
    '注:该临时表的字段和库中的WaterRate表的字段基本一致,惟有一处不相同:PmWaterRead字段,这儿该字段是可以为空的
    '   目的是:先导入上月读数,而对于新用户,显然上月无数据应该从水表表中取初始读数,这时,就可通过该字段为空来判断
    '   是否是新用户
    '-------------------------
    Dim strSQL As String
    
    strSQL = "CREATE TABLE " & gWaterRate & "(" & _
                                                "[No] [decimal](18, 0) IDENTITY (1, 1) NOT NULL ," & _
                                                "[Ym] [char] (6) NOT NULL ," & _
                                                "[PID] [char] (2) NOT NULL ," & _
                                                "[QID] [char] (2) NOT NULL ," & _
                                                "[UID] [char] (5) NOT NULL ," & _
                                                "[UName] [varchar] (60) NOT NULL ," & _
                                                "[LinkAddr] [varchar] (60) NOT NULL ," & _
                                                "[WmID] [char] (6) NOT NULL ," & _
                                                "[MwmID] [char] (6) NOT NULL ," & _
                                                "[UTypeID] [char] (1) NOT NULL ," & _
                                                "[ChargeTypeID] [char] (1) NOT NULL ," & _
                                                "[Price] [decimal](18, 2) NOT NULL ," & _
                                                "[PmWaterRead] [decimal](18, 2) ," & _
                                                "[CmWaterRead] [decimal](18, 2) NOT NULL ," & _
                                                "[WaterRevise] [decimal](18, 2) NOT NULL ," & _
                                                "[PmOwe] [decimal](18, 2) NOT NULL ," & _
                                                "[CmOwe] [decimal](18, 2) NOT NULL ," & _
                                                "[WaterRates] [decimal](18, 2) NOT NULL ," & _
                                                "[FineRule] [decimal](18, 2) NOT NULL ," & _
                                                "[Status] [Char](1) NOT NULL," & _
                                                "[IID] [Char](8) NULL" & _
                                            ")"
    
    On Error GoTo ErrHandleExe
    gConnect.Execute strSQL
    On Error GoTo 0
    CreateWaterRateCount = True
    Exit Function
ErrHandleExe:
    CreateWaterRateCount = False
    On Error GoTo 0
End Function

Public Function DeleteWaterRateCount() As Boolean
    '-------------------------
    '功能：  删除水费计算临时表(表名为全局公有常量gWaterRate)
    '参数：
    '返回值: TRUE 删除成功  ；FALSE 删除失败
    '用法:
    '建立:   2001/6/15  by pc
    '修改:
    '修改内容:
    '-------------------------
    Dim strSQL As String
    
    strSQL = "DROP TABLE " & gWaterRate
    On Error GoTo ErrHandleExe
    gConnect.Execute strSQL
    On Error GoTo 0
    DeleteWaterRateCount = True
    Exit Function
ErrHandleExe:
    DeleteWaterRateCount = False
    On Error GoTo 0
End Function

Public Function NextYm(ByVal TheYm As String) As String
    '-------------------------
    '功能：  根据指定的年月,计算下个月的年月表达式(所有的年月表达式为yyyymm)
    '参数：
    '返回值: 下个月的年月表达式
    '用法:
    '建立:   2001/6/11  by pc
    '修改:
    '修改内容:
    '-------------------------
    Dim strTmpYear
    Dim strTmpMonth
    Dim strTmp
    
    strTmp = TheYm
    strTmpYear = Trim(Str(Mid(strTmp, 1, 4)))
    strTmpMonth = Trim(Str(Mid(strTmp, 5, 2)))
    If Val(strTmpMonth) = 12 Then
        strTmpYear = Trim(Str(Val(strTmpYear) + 1))
        strTmpMonth = "01"
    Else
        strTmpMonth = Trim(Str(Val(strTmpMonth) + 1))
        strTmpMonth = String(2 - Len(strTmpMonth), "0") & strTmpMonth
    End If
    strTmp = strTmpYear & strTmpMonth
    NextYm = strTmp
End Function


Public Function PreYm(ByVal TheYm As String) As String
    '-------------------------
    '功能：  根据指定的年月,计算上个月的年月表达式(所有的年月表达式为yyyymm)
    '参数：
    '返回值: 上个月的年月表达式
    '用法:
    '建立:   2001/6/11  by pc
    '修改:
    '修改内容:
    '-------------------------
    Dim strTmpYear
    Dim strTmpMonth
    Dim strTmp
    
    strTmp = TheYm
    strTmpYear = Trim(Str(Mid(strTmp, 1, 4)))
    strTmpMonth = Trim(Str(Mid(strTmp, 5, 2)))
    If Val(strTmpMonth) = 1 Then
        strTmpYear = Trim(Str(Val(strTmpYear) - 1))
        strTmpMonth = "12"
    Else
        strTmpMonth = Trim(Str(Val(strTmpMonth) - 1))
        strTmpMonth = String(2 - Len(strTmpMonth), "0") & strTmpMonth
    End If
    strTmp = strTmpYear & strTmpMonth
    PreYm = strTmp
End Function

Public Function CChinese(ByVal strNumerical As String) As String
    '-------------------------
    '功能：  将数字字符串转换为中文大写金额格式(注：只支持2位小数)
    '参数：  strNumerical 字符串格式的数字
    '返回值: 大写串
    '用法:
    '建立:   2001/6/21  by pc
    '修改:
    '修改内容:
    '-------------------------
    Dim crcNumerical As Currency    '参数的数字化变量
    Dim strIntegerPart As String    '整数部分
    Dim strDecimalPart As String    '小数部分
    Dim intLen As Integer, intCounter As Integer
    Dim strCh As String, strTempCh As String
    Dim strSeqCh1 As String, strSeqCh2 As String
    Dim strIntegerPart2Ch As String

    If Not IsNumeric(strNumerical) Then
         MsgBox "无效的数字"
         CChinese = ""
         Exit Function
    End If
    If Val(strNumerical) > 999999999999.99 Then
        MsgBox "数据超范围！！！"
        CChinese = ""
        Exit Function
    End If
    crcNumerical = Val(strNumerical)
    If crcNumerical = 0 Then
        CChinese = "零元整"
        Exit Function
    End If
    
    strIntegerPart2Ch = "零壹贰叁肆伍陆柒捌玖"
    strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
    strSeqCh2 = " 万亿兆"
    strIntegerPart = Trim(Str(Int(crcNumerical)))
    strDecimalPart = Trim(Str(Int((crcNumerical - Int(crcNumerical)) * 100)))
    strDecimalPart = String(2 - Len(strDecimalPart), "0") & strDecimalPart
    
    '整数部分处理
    strIntegerPart = CStr(CDec(strIntegerPart))
    intLen = Len(strIntegerPart)
    For intCounter = 1 To intLen
        strTempCh = Mid(strIntegerPart2Ch, Val(Mid(strIntegerPart, intCounter, 1)) + 1, 1)
        If strTempCh = "零" And intLen <> 1 Then
            If Mid(strIntegerPart, intCounter + 1, 1) = "0" Or (intLen - intCounter + 1) Mod 4 = 1 Then
                strTempCh = ""
            End If
        Else
            strTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))
        End If
        If (intLen - intCounter + 1) Mod 4 = 1 Then
            strTempCh = strTempCh & Mid(strSeqCh2, (intLen - intCounter + 1) \ 4 + 1, 1)
            If intCounter > 3 Then
                If Mid(strIntegerPart, intCounter - 3, 4) = "0000" Then strTempCh = Left(strTempCh, Len(strTempCh) - 1)
            End If
        End If
        strCh = strCh & Trim(strTempCh)
    Next
    CChinese = IIf(strCh = "零", "", strCh & "元")
    
    '小数部分
    strCh = ""
    If strDecimalPart <> "00" Then
        strTempCh = Mid(strIntegerPart2Ch, Val(Mid(strDecimalPart, 1, 1)) + 1, 1)
        If strTempCh = "零" Then
            If CChinese <> "" Then strCh = strCh & strTempCh
        Else
            strCh = strCh & strTempCh & "角"
        End If
        
        strTempCh = Mid(strIntegerPart2Ch, Val(Mid(strDecimalPart, 2, 1)) + 1, 1)
        If strTempCh <> "零" Then strCh = strCh & strTempCh & "分"
    End If
    CChinese = CChinese & strCh & "整"

End Function