clsvchdefbi.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsVchDefBI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'--------------------------------
'时间:2001.11.12
'版权:北京用友软件股份有限公司
'设计:章景峰
'编码:章景峰
'说明:U8资金管理---业务对象
'--------------------------------
Option Explicit

Public Function Init(ByVal DataSourceName As String, ByVal BIStyle As Long) As U8FDEso.EntityObject
    Dim objEO        As U8FDEso.EntityObject
    Dim objOID       As U8FDEso.OIDObject
    Dim objDataMgr   As New U8FDmgr.DataManager
    Dim objOIDMgr    As New U8FDmgr.OIDManager
    
    Set objEO = objDataMgr.LoadEOMetaData(DataSourceName, BIStyle)
    Set objOID = objOIDMgr.GetNewOID(DataSourceName, BIStyle, False)
    Set objEO.OID = objOID
    Set Init = objEO
    
    Set objOID = Nothing
    Set objEO = Nothing
    Set objDataMgr = Nothing
    Set objOIDMgr = Nothing
End Function

Public Function MoveTo(ByVal DataSourceName As String, MoveMode As U8FDEso.MoveModeEnum, ByVal BIStyle As Long, Optional OID As U8FDEso.OIDObject) As U8FDEso.EntityObject
    Dim objEO      As U8FDEso.EntityObject
    Dim objDataMgr As New U8FDmgr.DataManager
    
    Set objEO = objDataMgr.LoadEOMetaData(DataSourceName, BIStyle)
    
    If Not OID Is Nothing Then Set objEO.OID = OID
    If con.State = adStateClosed Then con.Open DataSourceName
    If objDataMgr.MoveTo(con, objEO, MoveMode, True) Then
        Set MoveTo = objEO
    Else
        Set MoveTo = Nothing
    End If
    
    Set objEO = Nothing
    Set objDataMgr = Nothing
End Function

Public Function FindByCode(DataSourceName As String, BIStyle As Long, Code As String) As U8FDEso.EntityObject
    Dim objEO      As U8FDEso.EntityObject
    Dim objDataMgr As New U8FDmgr.DataManager
    Dim objOID     As New U8FDEso.OIDObject
    Dim rec        As New ADODB.Recordset
    
    '----装载此业务对象的元数据（EntityObject）
    Set objEO = objDataMgr.LoadEOMetaData(DataSourceName, BIStyle)
    
    If con.State = adStateClosed Then con.Open DataSourceName
    '----Get Oid from ID
    rec.Open "Select " & objEO.SourceOIDField & " From " & objEO.SourceTable & " Where substring(" & objEO.SourceOIDField & ",1,2)=" & BIStyle & " and " & objEO("transactions_code").SourceField & " = '" & Code & "'", con
    
    If Not rec.EOF Then
        objOID = rec.Fields(objEO.SourceOIDField)
        Set objEO.OID = objOID
    Else
        'Err.Raise vbObjectError + 3001, , "当前代码不存在！"
        Set FindByCode = Nothing
        Exit Function
    End If
    
    rec.Close
    Set rec = Nothing
    
    '----
    objDataMgr.MoveTo con, objEO, U8FDEso.esoCurrent

    Set FindByCode = objEO
    
    Set objOID = Nothing
    Set objDataMgr = Nothing
    Set objEO = Nothing
End Function

Public Function Save(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, ByVal BIStyle As Long) As Boolean
    Dim objDataMgr As New U8FDmgr.DataManager
    Dim objOIDMgr  As New U8FDmgr.OIDManager
    Dim objOID     As U8FDEso.OIDObject
    
    If Not Validate(DataSourceName, EO, BIStyle) Then Exit Function
    If EO.State = esoAddNew Then
        Set objOID = objOIDMgr.GetNewOID(DataSourceName, BIStyle, True)
        Set EO.OID = objOID
    End If
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    Dim sql As String
    Dim rec As New ADODB.Recordset
    
    sql = "select count(*) from " & EO.SourceTable & " where substring(" & EO.SourceOIDField & ",1,2)='" & Mid(EO(EO.SourceOIDField).Value, 1, 2) & "' and " & EO.SourceOIDField & " <> '" & EO(EO.SourceOIDField).Value & "' and " & EO("transactions_code").SourceField & "='" & EO("transactions_code").Value & "'"
    rec.Open sql, con, adOpenDynamic, adLockOptimistic
    If rec.Fields(0).Value > 0 Then
        rec.Close
        Set rec = Nothing
        Exit Function
    End If
    rec.Close
    Set rec = Nothing
    
    If EO.BiType = 32 Or EO.DeriveBIType = 32 Or EO.BiType = 34 Or EO.DeriveBIType = 34 Then
        '先删除生成的利息单,再生成新的利息单
        If Not CreateAccrual(DataSourceName, EO) Then
            Exit Function
        End If
    End If
        
    Save = objDataMgr.Save(con, EO)
    
    Set objOIDMgr = Nothing
    Set objDataMgr = Nothing
    Set objOID = Nothing
End Function

Public Function CreateAccrual(DataSourceName As String, EO As U8FDEso.EntityObject) As Boolean
    Dim objEO      As New U8FDEso.EntityObject
    Dim objDataMgr As New U8FDmgr.DataManager
    Dim objOIDMgr  As New U8FDmgr.OIDManager
    Dim rec        As New ADODB.Recordset
    Dim rec2       As New ADODB.Recordset
    Dim sql        As String
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    If EO.BiType = 32 Or EO.DeriveBIType = 32 Then
        Set objEO = Init(DataSourceName, 51)
        
        sql = "select " & objEO.SourceOIDField & " from " & objEO.SourceTable & " where substring(" & objEO.SourceOIDField & ",1,2)=51 and " & objEO("rcv_acc_id").SourceField & "='" & EO("fixed_acc_id") & "'"
        rec.Open sql, con, adOpenDynamic, adLockOptimistic
        If Not rec.EOF Then
            objEO(objEO.SourceOIDField) = rec.Fields(0)
            If Not Delete(DataSourceName, objEO, objEO.BiType) Then
                Exit Function
            End If
        End If
        Set rec = Nothing
        
        objEO.State = U8FDEso.esoAddNew
        objEO("transactions_id") = objOIDMgr.GetNewOID(DataSourceName, objEO.BiType, True).ID
        objEO("transactions_code") = GetMaxCode(DataSourceName, objEO, objEO.BiType)
        objEO("bill_date") = EO("bill_date")
        objEO("rcv_acc_id") = EO("fixed_acc_id")
        
        If Not GetFixInfo(DataSourceName, EO, EO("fixed_acc_id")) Is Nothing Then
            Set rec2 = GetFixInfo(DataSourceName, EO, EO("fixed_acc_id"))
            rec2.MoveFirst
            objEO("sum_mny") = EO("sum_mny") - rec2(EO.Fields.Item("sum_mny").Name) 'EO("sum_mny")为本息合计，此处应为利息值.EO("sum_mny")-本金
            Set rec2 = Nothing
        Else
            objEO("sum_mny") = EO("sum_mny") 'EO("sum_mny")为本息合计，此处应为利息值.EO("sum_mny")-本金
        End If
        
        objEO("mh_mny") = EO("sum_mny")
        objEO("exchange_rate") = EO("exchange_rate")
        objEO("natural_mny") = EO("natural_mny")
        
        objEO("from_date") = EO("bill_date")
        objEO("to_date") = EO("bill_date")
        
        objEO("irate_id") = EO("irate_id")
        objEO("digest") = "应计利息"
        objEO("bill_name") = EO("bill_name")
        objEO("vouchertype_flag") = 1
    ElseIf EO.BiType = 34 Or EO.DeriveBIType = 34 Then
        Set objEO = Init(DataSourceName, 54)
        
        sql = "select " & objEO.SourceOIDField & " from " & objEO.SourceTable & " where substring(" & objEO.SourceOIDField & ",1,2)=54 and " & objEO("rcv_acc_id").SourceField & "='" & EO("fixed_acc_id") & "'"
        rec.Open sql, con, adOpenDynamic, adLockOptimistic
        If Not rec.EOF Then
            objEO(objEO.SourceOIDField) = rec.Fields(0)
            If Not Delete(DataSourceName, objEO, objEO.BiType) Then
                Exit Function
            End If
        End If
        Set rec = Nothing
        objEO.State = U8FDEso.esoAddNew
        objEO("transactions_id") = objOIDMgr.GetNewOID(DataSourceName, objEO.BiType, True).ID
        objEO("transactions_code") = GetMaxCode(DataSourceName, objEO, objEO.BiType)
        objEO("bill_date") = EO("bill_date")
        objEO("rcv_acc_id") = EO("fixed_acc_id")
        
        If Not GetFixInfo(DataSourceName, EO, EO("fixed_acc_id")) Is Nothing Then
            Set rec2 = GetFixInfo(DataSourceName, EO, EO("fixed_acc_id"))
            rec2.MoveFirst
            objEO("sum_mny") = EO("sum_mny") - rec2(EO.Fields.Item("sum_mny").Name) 'EO("sum_mny")为本息合计，此处应为利息值.EO("sum_mny")-本金
            Set rec2 = Nothing
        Else
            objEO("sum_mny") = EO("sum_mny") 'EO("sum_mny")为本息合计，此处应为利息值.EO("sum_mny")-本金
        End If
        
        objEO("mh_mny") = EO("sum_mny") '+计算利息
        objEO("exchange_rate") = EO("exchange_rate")
        objEO("natural_mny") = EO("natural_mny")
        
        objEO("from_date") = EO("bill_date")
        objEO("to_date") = EO("bill_date")
        
        objEO("irate_id") = EO("irate_id")
        objEO("digest") = "应计利息"
        objEO("bill_name") = EO("bill_name")
        objEO("vouchertype_flag") = 1
    End If
    
    If objDataMgr.Save(con, objEO) Then
        CreateAccrual = True
    Else
        CreateAccrual = False
    End If
    
    Set objOIDMgr = Nothing
    Set objEO = Nothing
    Set objDataMgr = Nothing
End Function

Public Function Delete(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, ByVal BIStyle As Long, Optional MsgXml As String) As Boolean
    Dim objDataMgr As New U8FDmgr.DataManager
    Dim rec        As New ADODB.Recordset
    Dim sql        As String
    
    MsgXml = ""
    If con.State = adStateClosed Then con.Open DataSourceName
    If EO.BiType = 31 Or EO.DeriveBIType = 31 Or EO.BiType = 33 Or EO.DeriveBIType = 33 Then
        sql = "select * from fd_transactions,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 fixed_acc_id='" & EO("fixed_acc_id") & "'"
        rec.Open sql, con, adOpenDynamic, adLockReadOnly
        If Not rec.EOF Then
            MsgXml = "这笔存款已经生成取款单，不能删除！"
            Delete = False
            rec.Close
            Exit Function
        End If
        rec.Close
    End If
    If EO.BiType = 41 Or EO.DeriveBIType = 41 Or EO.BiType = 43 Or EO.DeriveBIType = 43 Or EO.BiType = 45 Or EO.DeriveBIType = 45 Then
        sql = "select * from fd_transactions where correspond_vch_id='" & EO("transactions_id") & "'"
        rec.Open sql, con, adOpenDynamic, adLockReadOnly
        If Not rec.EOF Then
            MsgXml = "这笔业务已经生成还款单，不能删除！"
            Delete = False
            rec.Close
            Exit Function
        End If
        rec.Close
    End If
    sql = "select cBus_id From FD_Vouch where cBus_id = '" & EO.BiType & EO("transactions_code") & " '"
    rec.Open sql, con, adOpenDynamic, adLockReadOnly
    If Not rec.EOF Then
        MsgXml = "这笔业务已经生成凭证，不能删除！"
        Delete = False
        rec.Close
        Exit Function
    End If
    rec.Close
    Delete = objDataMgr.Delete(con, EO)
    Set objDataMgr = Nothing
End Function

Public Function DeleteBIType(ByVal DataSourceName As String, ByVal BIStyle As Long) As Boolean
    Dim objDataMgr      As New U8FDmgr.DataManager
    Dim cmdDeleteFields As ADODB.Command
    Dim prmDeleteFields As ADODB.Parameter

    If con.State = adStateClosed Then con.Open DataSourceName
    DeleteBIType = objDataMgr.DeleteBIType(con, BIStyle)
    
    Set cmdDeleteFields = New ADODB.Command
    Set cmdDeleteFields.ActiveConnection = con
    cmdDeleteFields.CommandText = "FD_DeleteFields"
    cmdDeleteFields.CommandType = adCmdStoredProc
    cmdDeleteFields.CommandTimeout = 15
    
    Set prmDeleteFields = New ADODB.Parameter
    Set prmDeleteFields = cmdDeleteFields.CreateParameter("BIStyle", adInteger, adParamInput, 1, BIStyle)
    cmdDeleteFields.Parameters.Append prmDeleteFields
    
    cmdDeleteFields.Execute