clsloanlimitbi.cls

财务信息管理系统,适合做毕业论文的人使用

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsLoanLimitBI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'--------------------------------
'时间:2002.06.07
'版权:北京用友软件股份有限公司
'设计:罗涛
'编码:罗涛
'说明:U8资金管理---取贷款额度
'--------------------------------

Option Explicit
'数据库联接字符串名
Private g_sDatasourceName As String

'贷款相关参数
Private m_loanValue As Double '贷款控制额度
Private m_loanType As Boolean
Private m_balance As Double  '可适用余额
Private m_errMessage As String
'数据库操作参量
Private con As New ADODB.Connection
Private rs As New ADODB.Recordset
Private sqlstr As String

'设置连接字符串
Public Function setConnectionStr(conStr As String) As Boolean
    On Error GoTo Error0
    If con.State = adStateOpen Then
        con.Close
    End If
    g_sDatasourceName = conStr
    con.CursorLocation = adUseClient
    con.ConnectionString = conStr
    con.Open
    setConnectionStr = True
    Exit Function
Error0:
    'MsgBox con.Errors(0).Description, vbInformation, "属性设置错误"
    m_errMessage = Err.Description
    If con.State = adStateOpen Then
        con.Close
    End If
    setConnectionStr = False
    g_sDatasourceName = ""
End Function

Public Sub getByUnitCode(ByVal unitCode As String, ByVal ldate As String)
    Dim date1, date2 As String
    If rs.State = adStateOpen Then
        rs.Close
    End If
    On Error GoTo Error0
    If g_sDatasourceName = "" Then
        'MsgBox "未设置数据库联接字符串！" & vbCrLf & "请调用setConnectionStr方法进行设置！", vbInformation, "属性设置错误"
        m_errMessage = "未设置数据库联接字符串"
        m_loanValue = -1
        m_loanType = False
        Exit Sub
    End If
    If unitCode = "" Then
        'MsgBox "参数不允许为空值！", vbInformation, "参数错误"
        m_errMessage = "参数不允许为空值"
        m_loanValue = -1
        m_loanType = False
        Exit Sub
    End If
    sqlstr = "select count(*) from fd_accunit where Cunitcode='" & Trim(unitCode) & "';"
    rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If rs(0) = 0 Then
        'MsgBox "单位代码输入错误！", vbInformation, "参数错误"
        m_errMessage = "单位代码输入错误"
        m_loanValue = -1
        m_loanType = False
        rs.Close
        Exit Sub
    Else
        If rs.State = adStateOpen Then
            rs.Close
        End If
    End If
    If DateCheck(ldate, True) = "" Then
        m_errMessage = "日期参数输入错误"
        m_loanValue = -1
        m_loanType = False
        Exit Sub
    End If
    sqlstr = "select btype,borLimValue,avalDateStart,avalDateEnd from fd_borQuaLimSet where (cUnitcode='" & Trim(unitCode) & "') "
    sqlstr = sqlstr & "And ('" & DateCheck(ldate) & "' between avalDateStart and avalDateEnd);"
    rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If rs.RecordCount > 0 Then
        m_loanValue = CDbl(rs("borLimValue"))
        m_loanType = rs("btype")
        date1 = DateCheck(rs("avalDateStart"))
        date2 = IIf(IsNull(rs("avalDateEnd")), DateCheck(Date), DateCheck(rs("avalDateEnd")))
        rs.Close
        'Exit Sub
    Else
        'MsgBox "该单位未设置贷款额度！", vbInformation, "系统信息"
        m_errMessage = "该单位未设置贷款额度"
        m_loanValue = -1
        m_loanType = False
        rs.Close
        Exit Sub
    End If
    sqlstr = "select sum( case when commission_mny is Null then sum_mny else commission_mny end) from fd_transactions "
    sqlstr = sqlstr & "where ((SUBSTRING(transactions_id, 1, 2) IN (SELECT iId From fd_entities WHERE dbo.fd_entities.iBIType = '61')))"
    sqlstr = sqlstr & " And (fd_transactions.rcv_acc_id in (select fd_accdef.accdef_id from fd_accdef where fd_accdef.Cunitcode='" & Trim(unitCode) & "'))"
    sqlstr = sqlstr & " And (from_date between '" & date1 & "' and  '" & date2 & "');"
    rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    
    If Not (rs.EOF Or rs.BOF) Then
        If Not IsNull(rs(0)) Then
        m_balance = CDbl(rs(0))
        Else
            m_balance = m_loanValue
        End If
    Else
        m_balance = m_loanValue
    End If
    m_errMessage = ""
    rs.Close
    Set rs = Nothing
    Exit Sub
Error0:
    'MsgBox Err.Description, vbInformation, "错误信息"
    m_errMessage = Err.Description
    m_loanValue = -1
    m_loanType = False
    If rs.State = adStateOpen Then
        rs.Close
    End If
End Sub

Public Sub getByAccCode(ByVal accCode As String, ByVal ldate As String)
    Dim str As String
    If rs.State = adStateOpen Then
        rs.Close
    End If
    On Error GoTo Error0
    If g_sDatasourceName = "" Then
        'MsgBox "未设置数据库联接字符串！" & vbCrLf & "请调用setConnectionStr方法进行设置！", vbInformation, "属性设置错误"
        m_errMessage = "未设置数据库联接字符串"
        m_loanValue = -1
        m_loanType = False
        Exit Sub
    End If
    If accCode = "" Then
        'MsgBox "参数不允许为空值！", vbInformation, "参数错误"
        m_errMessage = "参数不允许为空值"
        m_loanValue = -1
        m_loanType = False
        Exit Sub
    End If
    sqlstr = "select CUnitcode from fd_accdef where Caccid='" & Trim(accCode) & "';"
    rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If rs.RecordCount = 0 Then
        'MsgBox "账户号输入错误！", vbInformation, "参数错误"
        m_errMessage = "账户号输入错误"
        m_loanValue = -1
        m_loanType = False
        rs.Close
        Exit Sub
    Else
        str = Trim(rs("CUnitCode"))
        If rs.State = adStateOpen Then
            rs.Close
        End If
    End If
    Call getByUnitCode(str, ldate)
    Exit Sub
Error0:
    'MsgBox Err.Description, vbInformation, "错误信息"
    m_errMessage = "参数不允许为空值"
    m_loanValue = -1
    m_loanType = False
    If rs.State = adStateOpen Then
        rs.Close
    End If
End Sub

Property Get loanvalue()
    loanvalue = m_loanValue
End Property
Property Get errMessage()
    errMessage = m_errMessage
    'loanType = m_loanType
End Property
Property Get balance()
    balance = m_balance
End Property

Private Sub Class_Initialize()
    m_errMessage = ""
    m_loanValue = -1
    m_loanType = False
    m_balance = -1

End Sub

Private Sub Class_Terminate()
    If con.State = adStateOpen Then
        con.Close
    End If
    If rs.State = adStateOpen Then
        rs.Close
    End If
    Set rs = Nothing
    Set con = Nothing
    m_errMessage = ""
    m_loanValue = -1
    m_loanType = False
    m_balance = -1
End Sub
'用于检查EDIT控件的日期是否合法
'第二个参数用于是否需要错误提示
Private Function DateCheck(cDateExp As Variant, Optional IsShowErrorMsg As Boolean) As String
    Dim date1 As String, date2 As String, dat As String
    Dim l As Integer, m As Integer
    Dim cOperater As String
    dat = Trim(cDateExp)
    m = Len(dat)
    If dat = "" Then
        DateCheck = ""
        If IsShowErrorMsg Then MsgBox "日期不能为空!", vbCritical
        Exit Function
    Else
        Do While l <> -1
            If InStr(dat, ".") Then
                cOperater = "."
                l = InStr(dat, cOperater)
                If l > 0 Then
                    date1 = Mid(dat, 1, l - 1)
                    date2 = Mid(dat, l + 1)
                    dat = date1 & "/" & date2
                End If
            Else
                l = -1
            End If
        Loop
    End If
    If IsDate(dat) Then
        DateCheck = Format(dat, "YYYY/MM/DD")
    Else
        DateCheck = ""
        If IsShowErrorMsg Then MsgBox "日期非法!", vbCritical
    End If
End Function