clscreclassbi.cls

u8

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

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

'贷款相关参数
Private m_creClass As String
Private m_default_loanValue As Double
'数据库操作参量
Private con As New ADODB.Connection
Private rs As New ADODB.Recordset
Private sqlstr As String

'保存信用等级和得分下限的数组
Private creClassArray() As Variant
'是否定义了等级信息
Private m_errMessage As String
Private creClassSetted As Boolean

'设置连接字符串
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 = g_sDatasourceName
    con.Open
    setConnectionStr = True
    Call setcreClassArray
    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

Private Sub setcreClassArray()
    Dim i As Integer
    On Error GoTo Error0
    sqlstr = "select creclass,lowMark,borLim from fd_creclass order by lowMark asc;"
    rs.Open sqlstr
    If rs.RecordCount > 0 Then
        ReDim creClassArray(rs.RecordCount - 1, 2)
    Else
        'MsgBox "系统还未设置信用等级！", vbInformation, "系统信息"
        m_errMessage = "系统还未设置信用等级"
        ReDim creClassArray(0, 2)
        creClassArray(0, 0) = "#"
        creClassArray(0, 1) = "#"
        creClassArray(0, 2) = "#"
        rs.Close
        m_default_loanValue = -1
        m_creClass = ""
        Exit Sub
    End If
    For i = 0 To UBound(creClass)
        creClassArray(i, 0) = IIf(IsNull(rs("creClass")), "", Trim(rs("creClass")))
        creClassArray(i, 1) = CDbl(IIf(IsNull(rs("lowMark")), 0, Trim(rs("lowMark"))))
        creClassArray(i, 2) = CDbl(IIf(IsNull(rs("borLim")), 0, Trim(rs("borLim"))))
        rs.MoveNext
    Next
    rs.Close
    Exit Sub
Error0:
    'MsgBox Err.Description, vbInformation, "系统信息"
    m_errMessage = Err.Description
    m_default_loanValue = -1
    m_creClass = ""

    If rs.State = adStateOpen Then
        rs.Close
    End If
End Sub
Public Sub getByUnitCode(ByVal unitCode 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_default_loanValue = -1
        m_creClass = ""
        Exit Sub
    End If
    If unitCode = "" Then
        'MsgBox "参数不允许为空值！", vbInformation, "参数错误"
        m_errMessage = "参数不允许为空值"
        m_default_loanValue = -1
        m_creClass = ""
        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_default_loanValue = -1
        m_creClass = ""
        rs.Close
        Exit Sub
    Else
        If rs.State = adStateOpen Then
            rs.Close
        End If
    End If
    sqlstr = "select creClass from FD_creEstamate where cUnitcode='" & Trim(unitCode) & "';"
    rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If rs.RecordCount > 0 Then
        m_creClass = CStr(rs("creClass"))
        m_default_loanValue = getDefaultValue(m_creClass)
        m_errMessage = ""
        rs.Close
        Exit Sub
    Else
        'MsgBox "该单位未做信用评价！", vbInformation, "系统信息"
        m_errMessage = "该单位未做信用评价"
        m_creClass = -1
        m_default_loanValue = ""
        rs.Close
        Exit Sub
    End If
Error0:
    'MsgBox Err.Description, vbInformation, "错误信息"
    m_errMessage = Err.Description
    m_default_loanValue = -1
    m_creClass = ""
    If rs.State = adStateOpen Then
        rs.Close
    End If
End Sub

Public Sub getByAccCode(ByVal accCode 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_default_loanValue = -1
        m_creClass = ""
        Exit Sub
    End If
    If accCode = "" Then
        'MsgBox "参数不允许为空值！", vbInformation, "参数错误"
        m_errMessage = "参数不允许为空值"
        m_default_loanValue = -1
        m_creClass = ""
        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_default_loanValue = -1
        m_creClass = ""
        rs.Close
        Exit Sub
    Else
        str = Trim(rs("CUnitCode"))
        If rs.State = adStateOpen Then
            rs.Close
        End If
    End If
    Call getByUnitCode(str)
    Exit Sub
Error0:
    'MsgBox Err.Description, vbInformation, "错误信息"
    m_errMessage = Err.Description
    m_default_loanValue = -1
    m_creClass = ""
    If rs.State = adStateOpen Then
        rs.Close
    End If
End Sub

Private Function getDefaultValue(str As String) As Double
    If creClassArray(0, 0) = "#" And creClassArray(0, 1) = "#" And creClassArray(0, 2) = "#" Then
        'MsgBox "系统还未设置信用等级！", vbInformation, "系统信息"
        m_errMessage = "系统还未设置信用等级"
        getDefaultValue = -1
        m_creClass = ""
        Exit Function
    Else
        For i = 0 To UBound(creClassArray)
            If creClassArray(i, 0) = Trim(str) Then
                getDefaultValue = creClassArray(i, 2)
                Exit For
            End If
        Next
    End If
End Function

Property Get creClass()
    creClass = m_creClass
End Property

Property Get defaultLoanValue()
    defaultLoanValue = m_default_loanValue
End Property

Property Get errMessage()
    errMessage = m_errMessage
End Property


Private Sub Class_Initialize()
    m_creClass = ""
    m_default_loanValue = -1
    m_errMessage = ""
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_default_loanValue = -1
    m_creClass = ""
End Sub