clsvchdefbi.cls

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

'          i = i + 1
'       Wend
'       Dim Ax As Double, Bx As Double, Cx As Double
'       Ax = 0: Bx = 0: Cx = 0
'       If iDataSource = 0 Then
'          For i = 1 To j - 1
'             Ax = Ax + IIf(UfGridADO1.TextMatrix(nFixRows + i, 2) = "", 0, UfGridADO1.TextMatrix(nFixRows + i, 2))
'             Bx = Bx + IIf(UfGridADO1.TextMatrix(nFixRows + i, 3) = "", 0, UfGridADO1.TextMatrix(nFixRows + i, 3))
'          Next i
'          UfGridADO1.AddItem "" & Chr(9) & "本日合计:" & Chr(9) & _
'             IIf(Ax = 0, "", FormatCur(Ax)) & _
'             Chr(9) & IIf(Bx = 0, "", FormatCur(Bx)) & _
'             Chr(9) & UfGridADO1.TextMatrix(nFixRows + j - 1, 4)
'       Else
'          For i = 1 To j - 1
'             Ax = Ax + IIf(UfGridADO1.TextMatrix(nFixRows + i, 8) = "", 0, UfGridADO1.TextMatrix(nFixRows + i, 8))
'             Bx = Bx + IIf(UfGridADO1.TextMatrix(nFixRows + i, 9) = "", 0, UfGridADO1.TextMatrix(nFixRows + i, 9))
'          Next i
'
'          UfGridADO1.AddItem "" & Chr(9) & "本日合计:" & Chr(9) & "" & _
'             Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & _
'             Chr(9) & "" & Chr(9) & IIf(Ax = 0, "", FormatCur(Ax)) & _
'             Chr(9) & IIf(Bx = 0, "", FormatCur(Bx)) & Chr(9) & _
'             UfGridADO1.TextMatrix(nFixRows + j - 1, 10) & _
'             Chr(9) & UfGridADO1.TextMatrix(nFixRows + j - 1, 11)
'       End If
'       End With
'       UfGridADO1.Row = 3
'       UfGridADO1.Col = 0
'       If iDataSource = 1 And UfGridADO1.Rows > 3 Then SwitchCodeToName
'
'        Set rec = Nothing
    Randomize
    GetAccBalance = CCur((100 * Rnd))
End Function

Public Function GetSettleCode(DataSourceName As String, ByVal CodeOrName As Boolean, Optional ByVal sqlwhere As String) As String
    Dim rec As New ADODB.Recordset
    Dim sql As String
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    sql = "select cSSCode,cSSName from SettleStyle where "
    
    If CodeOrName Then
        sql = sql & "cSSCode='" & sqlwhere & "'"
    Else
        sql = sql & "cSSName='" & sqlwhere & "'"
    End If
    
    rec.Open sql, con, adOpenDynamic
    
    If Not rec.EOF Then
        If CodeOrName Then
            GetSettleCode = rec("cSSName")
        Else
            GetSettleCode = rec("cSSCode")
        End If
    Else
        GetSettleCode = ""
    End If
    
    Set rec = Nothing
End Function

Public Function GetEqualSubjectCode(DataSourceName As String, ByVal CodeOrName As Boolean, Optional ByVal sqlwhere As String) As String
    Dim rec As New ADODB.Recordset
    Dim sql As String
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    sql = "select ccode,ccode_name from code where "
    
    If CodeOrName Then
        sql = sql & "ccode='" & sqlwhere & "'"
    Else
        sql = sql & "ccode_name='" & sqlwhere & "'"
    End If
    
    rec.Open sql, con, adOpenDynamic
    
    If Not rec.EOF Then
        If CodeOrName Then
            GetEqualSubjectCode = rec("ccode_name")
        Else
            GetEqualSubjectCode = rec("ccode")
        End If
    Else
        GetEqualSubjectCode = ""
    End If
    
    Set rec = Nothing
End Function

Public Function GetCalcTypeDesc(Optional ByVal Code As Integer = 0) As String
    Dim CalcType(3) As String
    
    If Code > 3 Then Code = 0
    
    CalcType(0) = "到期内利息挂账不计复利，逾期时对本金及结欠利息计复利"
    CalcType(1) = "到期内利息计复利，逾期时对本金及结欠利息计复利"
    CalcType(2) = "到期内利息挂账不计复利，逾期时只对本金计逾期利息"
    CalcType(3) = "利随本清"
    
    GetCalcTypeDesc = CalcType(Code)
End Function

Public Function GetMaxCode(DataSourceName As String, EO As U8FDEso.EntityObject, ByVal BIStyle As Long) As String
    Dim rec As New ADODB.Recordset
    Dim sql As String
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    sql = "select max(" & EO("transactions_code").SourceField & ") from " & EO.SourceTable & " where substring(" & EO.SourceOIDField & ",1,2)=" & BIStyle
    
    rec.Open sql, con, adOpenDynamic
    
    If Not rec.EOF Then
        If IsNull(rec.Fields(0).Value) Then
            GetMaxCode = String(EO("transactions_code").Length - 1, "0") & "1"
        ElseIf rec.Fields(0).Value = String(EO("transactions_code").Length, "9") Then
            GetMaxCode = ""
        Else
            GetMaxCode = Right(String(10, "0") & (IIf(IsNull(rec.Fields(0).Value), 0, rec.Fields(0).Value) + 1), 10)
        End If
    Else
        GetMaxCode = ""
    End If
    
    Set rec = Nothing
End Function
'还款单, 已还本金额
Public Function GetPrincipal_mny(DataSourceName As String, EO As U8FDEso.EntityObject, correspond_vch_id As String) As Currency
    Dim rec As New ADODB.Recordset
    Dim sql As String
    Dim objEO As New U8FDEso.EntityObject
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    If EO.BiType = 64 Or EO.DeriveBIType = 64 Then
        Set objEO = Init(DataSourceName, Mid(correspond_vch_id, 1, 2))
        If objEO.BiType = 41 Or objEO.DeriveBIType = 41 Then
            sql = "select sum(" & EO("principal_mny").SourceField & ") from " & EO.SourceTable & ",fd_entities where substring(" & EO.SourceTable & "." & EO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=42 or iDeriveBIType=42) and " & EO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
        ElseIf objEO.BiType = 43 Or objEO.DeriveBIType = 43 Then
            sql = "select sum(" & EO("principal_mny").SourceField & ") from " & EO.SourceTable & ",fd_entities where substring(" & EO.SourceTable & "." & EO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=44 or iDeriveBIType=44) and " & EO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
        End If
    Else
        sql = "select sum(" & EO("principal_mny").SourceField & ") from " & EO.SourceTable & ",fd_entities where substring(" & EO.SourceTable & "." & EO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=" & IIf(EO.DeriveBIType = 0, EO.BiType, EO.DeriveBIType) & " or iDeriveBIType=" & IIf(EO.DeriveBIType = 0, EO.BiType, EO.DeriveBIType) & ") and " & EO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
    End If
    
    If EO.State = U8FDEso.esoEdit Then
        sql = sql & " and " & EO.SourceOIDField & "<>'" & EO(EO.SourceOIDField) & "'"
    End If
    
    rec.Open sql, con, adOpenDynamic
    
    If Not rec.EOF Then
        GetPrincipal_mny = IIf(IsNull(rec.Fields(0)), 0, rec.Fields(0))
    Else
        GetPrincipal_mny = 0
    End If
    
    Set rec = Nothing
End Function
'利息单:41=42+52.43=44+53.45=46+55, 已还利息额
Public Function GetInterest_mny(DataSourceName As String, EO As U8FDEso.EntityObject, correspond_vch_id As String) As Currency
    Dim rec As New ADODB.Recordset
    Dim sql As String
    Dim objEO As New U8FDEso.EntityObject
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    'If EO.BIType = 42 Then
    '    sql = "select sum(" & EO("interest_mny").SourceField & ") from " & EO.SourceTable & " where substring(" & EO.SourceOIDField & ",1,2)='52' and " & EO("correspond_vch_id").SourceField & "='" & EO(EO("correspond_vch_id").SourceField) & "'"
    'ElseIf EO.BIType = 44 Then
    '    sql = "select sum(" & EO("interest_mny").SourceField & ") from " & EO.SourceTable & " where substring(" & EO.SourceOIDField & ",1,2)='53' and " & EO("correspond_vch_id").SourceField & "='" & EO(EO("correspond_vch_id").SourceField) & "'"
    'ElseIf EO.BIType = 46 Then
    '    sql = "select sum(" & EO("interest_mny").SourceField & ") from " & EO.SourceTable & " where substring(" & EO.SourceOIDField & ",1,2)='55' and " & EO("correspond_vch_id").SourceField & "='" & EO(EO("correspond_vch_id").SourceField) & "'"
    'End If
    If EO.BiType = 64 Or EO.DeriveBIType = 64 Then
        Set objEO = Init(DataSourceName, Mid(correspond_vch_id, 1, 2))
        If objEO.BiType = 41 Or objEO.DeriveBIType = 41 Then
            sql = "select sum(" & EO("interest_mny").SourceField & ") from " & EO.SourceTable & ",fd_entities where substring(" & EO.SourceTable & "." & EO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=52 or iDeriveBIType=52) and " & EO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
        ElseIf objEO.BiType = 43 Or objEO.DeriveBIType = 43 Then
            sql = "select sum(" & EO("interest_mny").SourceField & ") from " & EO.SourceTable & ",fd_entities where substring(" & EO.SourceTable & "." & EO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=53 or iDeriveBIType=53) and " & EO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
        End If
    Else
        sql = "select sum(" & EO("interest_mny").SourceField & ") from " & EO.SourceTable & ",fd_entities where substring(" & EO.SourceTable & "." & EO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=" & IIf(EO.DeriveBIType = 0, EO.BiType, EO.DeriveBIType) & " or iDeriveBIType=" & IIf(EO.DeriveBIType = 0, EO.BiType, EO.DeriveBIType) & ") and " & EO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
    End If
    
    If EO.State = U8FDEso.esoEdit Then
        sql = sql & " and " & EO.SourceOIDField & "<>'" & EO(EO.SourceOIDField) & "'"
    End If
    
    rec.Open sql, con, adOpenDynamic
    
    If Not rec.EOF Then
        GetInterest_mny = IIf(IsNull(rec.Fields(0)), 0, rec.Fields(0))
    Else
        GetInterest_mny = 0
    End If
    
    Set rec = Nothing
End Function
'利息单:41=42+52.43=44+53.45=46+55, 全部利息额
Public Function GetTotalInterest_mny(DataSourceName As String, EO As U8FDEso.EntityObject, correspond_vch_id As String) As Currency
    Dim rec   As New ADODB.Recordset
    Dim sql   As String
    Dim objEO As New U8FDEso.EntityObject

    If con.State = adStateClosed Then con.Open DataSourceName
    
    If EO.BiType = 42 Or EO.DeriveBIType = 42 Then
        Set objEO = Init(DataSourceName, 52)
        sql = "select sum(" & objEO("sum_mny").SourceField & ") from " & objEO.SourceTable & ",fd_entities where substring(" & objEO.SourceTable & "." & objEO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=52 or iDeriveBIType=52) and " & objEO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
    ElseIf EO.BiType = 44 Or EO.DeriveBIType = 44 Then
        Set objEO = Init(DataSourceName, 53)
        sql = "select sum(" & objEO("sum_mny").SourceField & ") from " & objEO.SourceTable & ",fd_entities where substring(" & objEO.SourceTable & "." & objEO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=53 or iDeriveBIType=53) and " & objEO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
    ElseIf EO.BiType = 46 Or EO.DeriveBIType = 46 Then
        Set objEO = Init(DataSourceName, 55)
        sql = "select sum(" & objEO("sum_mny").SourceField & ") from " & objEO.SourceTable & ",fd_entities where substring(" & objEO.SourceTable & "." & objEO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=55 or iDeriveBIType=55) and " & objEO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
    ElseIf EO.BiType = 64 Or EO.DeriveBIType = 64 Then
        Set objEO = Init(DataSourceName, Mid(correspond_vch_id, 1, 2))
        If objEO.BiType = 41 Or objEO.DeriveBIType = 41 Then
            Set objEO = Init(DataSourceName, 52)
            sql = "select sum(" & objEO("sum_mny").SourceField & ") from " & objEO.SourceTable & ",fd_entities where substring(" & objEO.SourceTable & "." & objEO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=52 or iDeriveBIType=52) and " & objEO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
        ElseIf objEO.BiType = 43 Or objEO.DeriveBIType = 43 Then
            Set objEO = Init(DataSourceName, 53)
            sql = "select sum(" & objEO("sum_mny").SourceField & ") from " & objEO.SourceTable & ",fd_entities where substring(" & objEO.SourceTable & "." & objEO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=53 or iDeriveBIType=53) and " & objEO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
        End If
    End If
    
    rec.Open sql, con, adOpenDynamic
    
    If Not rec.EOF Then
        GetTotalInterest_mny = IIf(IsNull(rec.Fields(0)), 0, rec.Fields(0))
    Else
        GetTotalInterest_mny = 0
    End If
    
    Set rec = Nothing
    Set objEO = Nothing
End Function

Public Function ReturnIsBooked(DataSourceName As String, EO As U8FDEso.EntityObject, correspond_vch_id As String) As Boolean
    Dim rec   As New ADODB.Recordset
    Dim sql   As String

    If con.State = adStateClosed Then con.Open DataSourceName
    
    If EO.BiType = 42 Or EO.DeriveBIType = 42 Then
        sql = "select sum(case when " & EO("book_name").SourceField & " is null then 1 else 0 end) from " & EO.SourceTable & ",fd_entities where substring(" & EO.SourceTable & "." & EO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=42 or iDeriveBIType=42) and " & EO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
    ElseIf EO.BiType = 44 Or EO.DeriveBIType = 44 Then
        sql = "select sum(case when " & EO("book_name").SourceField & " is null then 1 else 0 end) from " & EO.SourceTable & ",fd_entities where substring(" & EO.SourceTable & "." & EO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=44 or iDeriveBIType=44) and " & EO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
    ElseIf EO.BiType = 46 Or EO.DeriveBIType = 46 Then
        sql = "select sum(case when " & EO("book_name").SourceField & " is null then 1 else 0 end) from " & EO.SourceTable & ",fd_entities where substring(" & EO.SourceTable & "." & EO.SourceOIDField & ",1,2)=fd_entities.iBIType" & " and (iBIType=46 or iDeriveBIType=46) and " & EO("correspond_vch_id").SourceField & "='" & correspond_vch_id & "'"
    End If
    
    rec.Open sql, con, adOpenDynamic
    
    ReturnIsBooked = True
    
    If Not rec.EOF Then
        If rec.Fields(0).Value > 0 Then
            ReturnIsBooked = False
        End If
    End If
    
    Set rec = Nothing
End Function

Public Function GetCountByAcc(DataSourceName As String, EO As U8FDEso.EntityObject, Fixed_acc_id As String) As Long
    Dim rec As New ADODB.Recordset
    Dim sql As String
    
    If con.State = adStateClosed Then con.Open DataSourceName
    If EO.State = U8FDEso.esoAddNew Then
        'sql = "select count(" & EO.SourceOIDField & ") from " & EO.SourceTable & ",fd_entities where substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType" & " and (iBIType=" & IIf(EO.DeriveBIType = 0, EO.BIType, EO.DeriveBIType) & " or iDeriveBIType=" & IIf(EO.DeriveBIType = 0, EO.BIType, EO.DeriveBIType) & ") and " & EO.SourceOIDField & "<>'" & EO(EO.SourceOIDField).Value & "' and " & EO("fixed_acc_id").SourceField & "='" & Fixed_acc_id & "'"
        sql = "select count(" & EO.SourceOIDField & ") from " & EO.SourceTable & ",fd_entities where substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType" & " and (iBIType=31 or iDeriveBIType=31 or iBIType=33 or iDeriveBIType=33) and " & EO("fixed_acc_id").SourceField & "='" & Fixed_acc_id & "'"
    Else
        sql = "select count(" & EO.SourceOIDField & ") from " & EO.SourceTable & ",fd_entities where substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType" & " and (iBIType=31 or iDeriveBIType=31 or iBIType=33 or iDeriveBIType=33) and " & EO.SourceOIDField & "<>'" & EO(EO.SourceOIDField).Value & "' and " & EO("fixed_acc_id").SourceField & "='" & Fixed_acc_id & "'"
    End If
    rec.Open sql, con, adOpenDynamic
    
    If Not rec.EOF Then
        GetCountByAcc = rec.Fields(0)
    Else
        GetCountByAcc = 0
    End If
    
    Set rec = Nothing
End Function