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