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