clsvchdefbi.cls

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

Public Function GetFixInfo(DataSourceName As String, EO As U8FDEso.EntityObject, Fixed_acc_id As String, Optional FixIsFetch As Boolean) As ADODB.Recordset
    Dim rec As New ADODB.Recordset
    Dim rec2 As New ADODB.Recordset
    Dim sql As String
    
    Dim SumField As String
    Dim FixSum   As Currency
    
    FixIsFetch = False
    FixSum = 0
    SumField = EO("sum_mny").SourceField
    
    If con.State = adStateClosed Then con.Open DataSourceName
    '定期取款单32、34
    If EO.State = U8FDEso.esoEdit Then
        If EO.BiType = 32 Or EO.DeriveBIType = 32 Or EO.BiType = 34 Or EO.DeriveBIType = 34 Then
            sql = "select fd_entities.iDeriveBIType,fd_entities.iBIType," & EO.SourceTable & ".* from " & EO.SourceTable & ",fd_entities where substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType" & " and (iBIType=32 or iDeriveBIType=32 or iBIType=34 or iDeriveBIType=34) and " & EO("fixed_acc_id").SourceField & "='" & Fixed_acc_id & "'" ' and " & EO.SourceOIDField & "<>'" & EO(EO.SourceOIDField) & "'"
        Else
            sql = "select fd_entities.iDeriveBIType,fd_entities.iBIType," & EO.SourceTable & ".* from " & EO.SourceTable & ",fd_entities where substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType" & " and (iBIType=32 or iDeriveBIType=32 or iBIType=34 or iDeriveBIType=34) and " & EO("fixed_acc_id").SourceField & "='" & EO("fixed_acc_id") & "'" ' and " & EO.SourceOIDField & "<>'" & EO(EO.SourceOIDField) & "'"
        End If
    Else
        sql = "select fd_entities.iDeriveBIType,fd_entities.iBIType," & EO.SourceTable & ".* from " & EO.SourceTable & ",fd_entities where substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType" & " and (iBIType=32 or iDeriveBIType=32 or iBIType=34 or iDeriveBIType=34) and " & EO("fixed_acc_id").SourceField & "='" & Fixed_acc_id & "'"
    End If
    rec.Open sql, con, adOpenDynamic
    
    If EO.State = U8FDEso.esoEdit Then
        If EO.BiType = 32 Or EO.DeriveBIType = 32 Or EO.BiType = 34 Or EO.DeriveBIType = 34 Then
            '定期存款单31、33
            'sql = "select fd_entities.iDeriveBIType,fd_entities.iBIType," & EO.SourceTable & ".* from " & EO.SourceTable & ",fd_entities where substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType" & " and (iBIType=31 or iDeriveBIType=31 or iBIType=32 or iDeriveBIType=32 or iBIType=33 or iDeriveBIType=33 or iBIType=34 or iDeriveBIType=34) and " & EO("fixed_acc_id").SourceField & "='" & Fixed_acc_id & "'" ' and " & EO.SourceOIDField & "<>'" & EO(EO.SourceOIDField) & "'"
            sql = "select fd_entities.iDeriveBIType,fd_entities.iBIType," & EO.SourceTable & ".* 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 & "'" ' and " & EO.SourceOIDField & "<>'" & EO(EO.SourceOIDField) & "'"
            '利息单51、54
            sql = sql & " union all select fd_entities.iDeriveBIType,fd_entities.iBIType," & EO.SourceTable & ".*" & " from " & EO.SourceTable & ",fd_entities where substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType" & " and (iBIType=51 or iDeriveBIType=51 or iBIType=54 or iDeriveBIType=54) and rcv_acc_id='" & Fixed_acc_id & "'" ' and " & EO.SourceOIDField & "<>'" & EO(EO.SourceOIDField) & "'"
            '一个账户只有一笔定期存款，相对应一笔取款、一笔利息单
        Else
            sql = "select fd_entities.iDeriveBIType,fd_entities.iBIType," & EO.SourceTable & ".* 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 & "='" & EO("fixed_acc_id") & "'" ' and " & EO.SourceOIDField & "<>'" & EO(EO.SourceOIDField) & "'"
            sql = sql & " union all select fd_entities.iDeriveBIType,fd_entities.iBIType," & EO.SourceTable & ".*" & " from " & EO.SourceTable & ",fd_entities where substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType" & " and (iBIType=51 or iDeriveBIType=51 or iBIType=54 or iDeriveBIType=54) and rcv_acc_id='" & EO("fixed_acc_id") & "'" ' and " & EO.SourceOIDField & "<>'" & EO(EO.SourceOIDField) & "'"
        End If
    Else
        sql = "select fd_entities.iDeriveBIType,fd_entities.iBIType," & EO.SourceTable & ".* 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 & "'"
        sql = sql & " union all select fd_entities.iDeriveBIType,fd_entities.iBIType," & EO.SourceTable & ".*" & " from " & EO.SourceTable & ",fd_entities where substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType" & " and (iBIType=51 or iDeriveBIType=51 or iBIType=54 or iDeriveBIType=54) and rcv_acc_id='" & Fixed_acc_id & "'"
    End If
    rec2.Open sql, con, adOpenDynamic
    
    If rec.EOF Then
        If Not rec2.EOF Then
            'rec2.MoveFirst
            'Do Until rec2.EOF
            '    If rec2!iBIType = 31 Or rec2!iDeriveBIType = 31 Then
            '        FixSum = FixSum + rec2(SumField).Value
            '    ElseIf rec2!iBIType = 32 Or rec2!iDeriveBIType = 32 Then
            '        FixSum = FixSum - rec2(SumField).Value
            '    ElseIf rec2!iBIType = 33 Or rec2!iDeriveBIType = 33 Then
            '        FixSum = FixSum + rec2(SumField).Value
            '    ElseIf rec2!iBIType = 34 Or rec2!iDeriveBIType = 34 Then
            '        FixSum = FixSum - rec2(SumField).Value
            '    ElseIf rec2!iBIType = 51 Or rec2!iDeriveBIType = 51 Then
            '        FixSum = FixSum + rec2(SumField).Value
            '    ElseIf rec2!iBIType = 54 Or rec2!iDeriveBIType = 54 Then
            '        FixSum = FixSum + rec2(SumField).Value
            '    End If
            '    rec2.MoveNext
            'Loop
        ElseIf EO.State = U8FDEso.esoEdit Then
            If EO.BiType = 32 Or EO.DeriveBIType = 32 Or EO.BiType = 34 Or EO.DeriveBIType = 34 Then
                FixIsFetch = True
            Else
                FixIsFetch = False
            End If
        Else
            FixIsFetch = True
        End If
    ElseIf rec(EO("fixed_acc_id").SourceField) = Fixed_acc_id Then
        FixIsFetch = False
    Else
        FixIsFetch = True
    End If
    
    If FixIsFetch = False Then
        Set GetFixInfo = rec2
    Else
        Set GetFixInfo = Nothing
    End If
    Set rec = Nothing
End Function

Public Function CheckVoucher(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, Flag As Boolean, CheckName As String, xmlErrMsg As String) As Boolean
    On Error GoTo lblHandle

    If EO("bill_name") = CheckName Then
        'xmlErrMsg = "<xml>" & vbNewLine
        'xmlErrMsg = xmlErrMsg & "<funcid>CheckVoucher</funcid>" & vbNewLine
        'xmlErrMsg = xmlErrMsg & "<errno>" & 0 & "</errno>" & vbNewLine
        'xmlErrMsg = xmlErrMsg & "<errmsg>" & "审核制单不能为同一人" & "</errmsg>" & vbNewLine
        'xmlErrMsg = xmlErrMsg & "</xml>"
        xmlErrMsg = "审核制单不能为同一人"
        CheckVoucher = False
        Exit Function
    Else
        If Flag Then '审核
            If Not IsNull(EO("check_name")) Then
                'xmlErrMsg = "<xml>" & vbNewLine
                'xmlErrMsg = xmlErrMsg & "<funcid>CheckVoucher</funcid>" & vbNewLine
                'xmlErrMsg = xmlErrMsg & "<errno>" & 0 & "</errno>" & vbNewLine
                'xmlErrMsg = xmlErrMsg & "<errmsg>" & "本张单子已审核" & "</errmsg>" & vbNewLine
                'xmlErrMsg = xmlErrMsg & "</xml>"
                xmlErrMsg = "本张单子已审核"
                CheckVoucher = False
                Exit Function
            Else
                EO("check_name") = CheckName
                Save DataSourceName, EO, EO.BiType
            End If
        Else '弃审
            If EO("check_name") = CheckName Then
                EO("check_name") = ""
                Save DataSourceName, EO, EO.BiType
            Else
                'xmlErrMsg = "<xml>" & vbNewLine
                'xmlErrMsg = xmlErrMsg & "<funcid>CheckVoucher</funcid>" & vbNewLine
                'xmlErrMsg = xmlErrMsg & "<errno>" & 0 & "</errno>" & vbNewLine
                'xmlErrMsg = xmlErrMsg & "<errmsg>" & "只有审核人才能弃审" & "</errmsg>" & vbNewLine
                'xmlErrMsg = xmlErrMsg & "</xml>"
                xmlErrMsg = "只有审核人才能弃审"
                CheckVoucher = False
                Exit Function
            End If
        End If
    End If
    CheckVoucher = True
    Exit Function
lblHandle:
    xmlErrMsg = "<xml>" & vbNewLine
    xmlErrMsg = xmlErrMsg & "<funcid>CheckVoucher</funcid>" & vbNewLine
    xmlErrMsg = xmlErrMsg & "<errno>" & Err.Number & "</errno>" & vbNewLine
    xmlErrMsg = xmlErrMsg & "<errmsg>" & Err.Description & "</errmsg>" & vbNewLine
    xmlErrMsg = xmlErrMsg & "</xml>"
    CheckVoucher = False
End Function

Public Function GetLoanFlagDesc(Optional ByVal Code As Integer = 0) As String
    Dim LoanFlag(1) As String
    
    If Code > 1 Then Code = 0
    
    LoanFlag(0) = "普通贷款"
    LoanFlag(1) = "自动还款贷款"
    
    GetLoanFlagDesc = LoanFlag(Code)
End Function

Public Function GetPrepayMny(ByVal DataSourceName As String, EO As U8FDEso.EntityObject) As Currency
    Dim objAccDefBI As New U8FDBso.clsAccDefBI
    Dim objUnitBI   As New U8FDBso.clsAccUnitBI
    Dim rec         As New ADODB.Recordset
    Dim sql         As String
    Dim objEO       As U8FDEso.EntityObject
    Dim OID         As U8FDEso.OIDObject
    Dim RcvUnitID   As String
    Dim PayUnitID   As String
    
    Set OID = New U8FDEso.OIDObject
    OID.ID = EO.Fields.Item("rcv_acc_id").Value
    Set objEO = objAccDefBI.MoveTo(DataSourceName, U8FDEso.esoCurrent, , OID)
    OID.ID = objEO.Fields.Item("accunit_id").Value
    Set objEO = objUnitBI.MoveTo(DataSourceName, U8FDEso.esoCurrent, , OID)
    RcvUnitID = objEO("accunit_id")
    OID.ID = EO.Fields.Item("pay_acc_id").Value
    Set objEO = objAccDefBI.MoveTo(DataSourceName, U8FDEso.esoCurrent, , OID)
    OID.ID = objEO.Fields.Item("accunit_id").Value
    Set objEO = objUnitBI.MoveTo(DataSourceName, U8FDEso.esoCurrent, , OID)
    PayUnitID = objEO("accunit_id")
    Set OID = Nothing
    Set objEO = Nothing
    
    'sql = "Select sum(" & EO("prepay_mny").SourceField & ") from " & EO.SourceTable
    'sql = "Select sum(" & EO("prepay_mny").SourceField & ") from fd_transactions,fd_entities,fd_accdef as rcv_acc,fd_accdef as pay_acc,fd_accunit as rcv_unit,fd_accunit as rcv_unit where substring(fd_transactions.transactions_id, 1, 2) = fd_entities.iBIType And (fd_entities.iBIType = 23 Or fd_entities.iDeriveBIType = 23) and fd_transactions.rcv_acc_id=rcv_acc.accdef_id and fd_transactions.pay_acc_id=pay_acc.accdef_id and rcv_unit.accunit_id=rcv_acc.accunit_id and pay_unit.accunit_id=pay_acc.accunit_id and  "
    If EO.State = U8FDEso.esoAddNew Then
        sql = "Select sum(" & EO("prepay_mny").SourceField & ") from fd_transactions,fd_entities,fd_accdef as rcv_acc,fd_accdef as pay_acc,fd_accunit as rcv_unit,fd_accunit as pay_unit where (fd_entities.iBIType=23 or fd_entities.iDeriveBIType=23) and substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType and fd_transactions.rcv_acc_id=rcv_acc.accdef_id and fd_transactions.pay_acc_id=pay_acc.accdef_id and rcv_unit.accunit_id=rcv_acc.accunit_id and pay_unit.accunit_id=pay_acc.accunit_id and rcv_unit.accunit_id='" & RcvUnitID & "' and pay_unit.accunit_id='" & PayUnitID & "'"
    Else
        sql = "Select sum(" & EO("prepay_mny").SourceField & ") from fd_transactions,fd_entities,fd_accdef as rcv_acc,fd_accdef as pay_acc,fd_accunit as rcv_unit,fd_accunit as pay_unit where (fd_entities.iBIType=23 or fd_entities.iDeriveBIType=23) and substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType and fd_transactions.rcv_acc_id=rcv_acc.accdef_id and fd_transactions.pay_acc_id=pay_acc.accdef_id and rcv_unit.accunit_id=rcv_acc.accunit_id and pay_unit.accunit_id=pay_acc.accunit_id and rcv_unit.accunit_id='" & RcvUnitID & "' and pay_unit.accunit_id='" & PayUnitID & "'" & " and fd_transactions.transactions_id<>'" & EO(EO.SourceOIDField) & "'"
    End If
    If con.State = adStateClosed Then con.Open DataSourceName
    rec.Open sql, con, adOpenDynamic, adLockOptimistic
    If IsNumeric(rec.Fields(0).Value) Then
        GetPrepayMny = rec.Fields(0).Value
    Else
        GetPrepayMny = 0
    End If
    
    rec.Close
    Set rec = Nothing
    Set objUnitBI = Nothing
    Set objAccDefBI = Nothing
End Function

Public Function GetLoanFlag(DataSourceName As String, correspond_vch_id As String) As String
    Dim rec As New ADODB.Recordset
    Dim sql As String
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    sql = "select loan_flag from fd_transactions left join fd_entities on substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType where (fd_entities.iBIType=41 or fd_entities.iDeriveBIType=41) and transactions_id='" & correspond_vch_id & "'"
    
    rec.Open sql, con, adOpenDynamic
    
    If Not rec.EOF Then
        GetLoanFlag = rec("loan_flag")
    Else
        GetLoanFlag = 0
    End If
    
    Set rec = Nothing
End Function

Public Function ApplyCreateLoan(DataSourceName As String, EO As U8FDEso.EntityObject, ExchangeRate As Double, Symbol As Boolean, UserID As String) As Boolean
    Dim objEO       As U8FDEso.EntityObject
    Dim objAccDefBI As New clsAccDefBI
    Dim Temp        As String
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    Set objEO = Init(DataSourceName, 41)
    objEO.State = U8FDEso.esoAddNew
    Temp = GetMaxCode(DataSourceName, objEO, 41)
    If Not Temp = "" Then
        objEO("transactions_code") = GetMaxCode(DataSourceName, objEO, 41)
    Else
        objEO("transactions_code") = "8765432109"
    End If
    objEO("bill_date") = IIf(IsNull(EO("return_date")), EO("bill_date"), EO("return_date"))
    If EO("rcv_acc_code").IsUsed Then
        objEO("rcv_acc_id") = EO("rcv_acc_id")
    Else
        Temp = objAccDefBI.FindByUnit(DataSourceName, EO("accunit_id"))
        If Not Temp = "" Then
            objEO("rcv_acc_id") = Temp
        Else
            Exit Function
        End If
    End If
    objEO("sum_mny") = EO("commission_mny")
    objEO("money_name") = IIf(IsNull(EO("money_name")), "", EO("money_name"))
    objEO("digest") = "申请贷款"
    objEO("bill_name") = UserID
    If IsNumeric(ExchangeRate) Then
        objEO("exchange_rate") = ExchangeRate
        If Symbol Then
            objEO("natural_mny") = EO("commission_mny") * ExchangeRate
        Else
            objEO("natural_mny") = EO("commission_mny") / ExchangeRate
        End If
    End If
    objEO("irate_id") = IIf(IsNull(EO("irate_id")), "", EO("irate_id"))
    objEO("cad_id") = IIf(IsNull(EO("cad_id")), "", EO("cad_id"))
    objEO("return_date") = IIf(IsNull(EO("userdefine27")), "", EO("userdefine27"))
    objEO("calctype_flag") = IIf(IsNull(EO("calctype_flag")), 3, EO("calctype_flag"))
    objEO("loan_flag") = 0
    
    ApplyCreateLoan = Save(DataSourceName, objEO, 41)
    
    Set objEO = Nothing
    Set objAccDefBI = Nothing
End Function

Public Function BatchCheck(DataSourceName As String, BiType As Long, CheckName As String, BillDate As Date, Optional ErrDescription As String) As Boolean
    Dim sql As String
    
    On Error GoTo lblHandle
    If con.State = adStateClosed Then con.Open DataSourceName
    sql = "update fd_transactions set check_name='" & CheckName & "' where substring(transactions_id,1,2)=" & BiType & " and not bill_name is null and check_name is null and book_name is null and bill_name<>'" & CheckName & "'" ' and bill_date<='" & BillDate & "'"
    con.Execute sql
    BatchCheck = True
    Exit Function
lblHandle:
    ErrDescription = Err.Description
End Function

Public Function BatchCancel(DataSourceName As String, BiType As Long, CheckName As String, BillDate As Date, Optional ErrDescription As String) As Boolean
    Dim sql As String
    
    On Error GoTo lblHandle
    If con.State = adStateClosed Then con.Open DataSourceName
    sql = "update fd_transactions set check_name=Null where substring(transactions_id,1,2)=" & BiType & " and not bill_name is null and check_name ='" & CheckName & "' and book_name is null" ' and bill_date<='" & BillDate & "'"
    con.Execute sql
    BatchCancel = True
    Exit Function
lblHandle:
    ErrDescription = Err.Description
End Function