clsiratebi.cls

用友U8财务软件VB源程序, 本版本为2002年版本

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

Private Const m_conBIStyle As Long = 8

''得到利率（指定日期、金额，主要用于得出定额利率）
'Public Function GetIRate(sDataSourceName As String, sOID As String, dDate As Date, cMoney As Currency) As Double
'
'End Function

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

Public Function MoveTo(ByVal DataSourceName As String, MoveMode As U8FDEso.MoveModeEnum, Optional ByVal BIStyle As Long = m_conBIStyle, 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 objDataMgr = Nothing
    Set objEO = Nothing
End Function

Public Function Save(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, Optional ByVal BIStyle As Long = m_conBIStyle) As Boolean
    Dim objDataMgr As New U8FDmgr.DataManager
    Dim objOIDMgr  As New U8FDmgr.OIDManager
    Dim objOID     As U8FDEso.OIDObject
    
    If Not Validate(DataSourceName, EO) Then Exit Function
    
    '这一步应该注释掉，eo.oid已经赋值，使用这一步会使OID再次加1。
    If EO.State = esoAddNew Then
        Set objOID = objOIDMgr.GetNewOID(DataSourceName, BIStyle)
        Set EO.OID = objOID
    End If
    If con.State = adStateClosed Then con.Open DataSourceName
    
    Save = objDataMgr.Save(con, EO)
    
    Set objOID = Nothing
    Set objOIDMgr = Nothing
    Set objDataMgr = Nothing
End Function

Public Function Delete(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, Optional ByVal BIStyle As Long = m_conBIStyle) As Boolean
    Dim objDataMgr As New U8FDmgr.DataManager
    
    If con.State = adStateClosed Then con.Open DataSourceName
    Delete = objDataMgr.Delete(con, EO)
    
    Set objDataMgr = Nothing
End Function

Public Function Validate(ByVal DataSourceName As String, EO As U8FDEso.EntityObject) As Boolean
    Select Case EO.State
        Case esoAddNew
        
        Case esoDelete
        
        Case esoEdit
        
        Case esoInitialized
        
        Case esoInstance
        
    End Select
    
    Dim oFO As FieldObject
    Dim i   As Integer
    
    If EO.EOS.Count > 0 Then
        With EO.EOS(EO.EOS.Count)
            For i = 1 To .Fields.Count
                Set oFO = .Fields.Item(i)
                If Not oFO.Name = EO.EOS.EOMetaData.ParentField And Not oFO.Name = EO.EOS.EOMetaData.SourceOIDField Then
                    '----已使用并可持久化
                    If oFO.IsUsed And oFO.Persistent Then
                        '----设置值为默认值
                        If IsEmpty(oFO.Value) Or IsNull(oFO.Value) Then
                            oFO.Value = oFO.DefaultValue
                        End If
                        
                        '----检查不允许为空的域对象是否为空
                        If Not oFO.AllowNull Then
                            If IsNull(oFO.Value) Then
                                Err.Raise vbObjectError + 3000, oFO.Name, oFO.Caption & "不能为空!"
                            End If
                        End If
                    End If
                End If
            Next
        End With
    End If
    
    Validate = True
End Function

Public Function LoadVchEOs(DataSourceName As String, Optional IsAll As Boolean = False) As U8FDEso.Entities
    Dim objEOs  As New U8FDEso.Entities
    Dim objEO   As U8FDEso.EntityObject
    Dim sql     As String
    Dim rec     As New ADODB.Recordset
    
    If con.State = adStateClosed Then con.Open DataSourceName
    If IsAll Then
        sql = "Select * From FD_Entities Where iVchType <> 0 Order by iID"
    Else
        sql = "Select * From FD_Entities Where iVchType <> 0 and iIsUsed=1 Order by iID"
    End If
    rec.Open sql, con
    Do Until rec.EOF
        Set objEO = New U8FDEso.EntityObject
        
        With objEO
            .ID = rec!iID
            .Name = rec!sName
            .Caption = rec!sCaption
            .State = esoInitialized
            .BIType = rec!iBIType
            .SourceOIDField = rec!sOIDSourceField
            .SourceTable = rec!sSourceTable
            .ParentField = IIf(IsNull(rec!sParentField), "", rec!sParentField)
            .TaskID = IIf(IsNull(rec!sTaskID), "", rec!sTaskID)
            .HelpContextID = IIf(IsNull(rec!sHelpContextID), "", rec!sHelpContextID)
            .Description = IIf(IsNull(rec!sDescription), "", rec!sDescription)
            .SheetID = IIf(IsNull(rec!iSheet), 0, rec!iSheet)
            .Rows = IIf(IsNull(rec!iRows), 0, rec!iRows)
            .Cols = IIf(IsNull(rec!iCols), 0, rec!iCols)
            .IsUsed = IIf(IsNull(rec!iIsUsed), 0, rec!iIsUsed)
            .PzSign = IIf(IsNull(rec!sPzSign), "", rec!sPzSign)
        End With
        
        objEOs.Append objEO, "K" & rec!iBIType
        
        rec.MoveNext
    Loop
    
    rec.Close
    Set rec = Nothing
    
    Set LoadVchEOs = objEOs
    
    Set objEO = Nothing
    Set objEOs = Nothing
End Function

Public Function SaveVchEOs(DataSourceName As String, EOS As U8FDEso.Entities) As Boolean
    Dim objDataMgr As New U8FDmgr.DataManager
    Dim i          As Integer
    
    If Not EOS Is Nothing Then
        For i = 1 To EOS.Count
            SaveVchEOs = objDataMgr.SaveEOMetaData(DataSourceName, EOS.Item(i), True)
        Next
    End If
    
    SaveVchEOs = True
    
    Set objDataMgr = Nothing
End Function

Public Function RecordCount(ByVal DataSourceName As String, EO As U8FDEso.EntityObject)
    Dim sql         As String
    Dim rec         As New ADODB.Recordset
    
    If con.State = adStateClosed Then con.Open DataSourceName
    sql = "Select count(*) From " & EO.SourceTable
    rec.Open sql, con, adOpenStatic, adLockOptimistic
    
    RecordCount = rec.Fields(0).Value
    
    rec.Close
    Set rec = Nothing
End Function

Public Function IrateIsExist(DataSourceName As String, ID As String) As Boolean
    Dim rec As New ADODB.Recordset
    
    IrateIsExist = False
    If con.State = adStateClosed Then con.Open DataSourceName
    rec.Open "Select irate_id From FD_Intra Where irate_id = '" & ID & "'", con
    If Not rec.EOF Then
       IrateIsExist = True
    End If
    rec.Close
    Set rec = Nothing
End Function

Public Function FindByCode(DataSourceName As String, Code As String, Optional ByVal BIStyle As Long = m_conBIStyle) 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 " & objEO("irate_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, esoCurrent

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

Public Function IsUsed(DataSourceName As String, ID As String) As Boolean
    Dim rec        As New ADODB.Recordset
    Dim sql        As String
    
    sql = "select 1 from fd_accdef where irate_id = '" & ID & "'"
    sql = sql & " union select 1 from fd_transactions where irate_id = '" & ID & "'"
    
    If con.State = adStateClosed Then con.Open DataSourceName
    rec.Open sql, con
    
    If Not rec.EOF Then
        IsUsed = True
    Else
        IsUsed = False
    End If
    
    rec.Close
    Set rec = Nothing
End Function