clscadbi.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 = "clsCadBI"
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 = 3

'判断是否是结息日
Public Function IsCAD(sDataSourceName As String, ID As String, dDate As Date) As Boolean
    Dim rec As New ADODB.Recordset

    OpenConnection con, sDataSourceName
    If OpenRecordset(con, rec, "Select cad_code From fd_cad_h Where cad_id = '" & ID & "'") Then
       IsCAD = True
    End If

    CloseRec rec
    
    Set rec = Nothing
End Function

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

Public Function MoveTo(DataSourceName As String, MoveMode As 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
    
    '----装载此业务对象的元数据（EntityObject）
    Set objEO = objDataMgr.LoadEOMetaData(DataSourceName, m_conBIStyle)

    '----赋oid值
    If Not OID Is Nothing Then Set objEO.OID = OID
    If con.State = adStateClosed Then con.Open DataSourceName
    '----
    objDataMgr.MoveTo con, objEO, MoveMode, True

    Set MoveTo = objEO
    
    Set objDataMgr = Nothing
    Set objEO = Nothing
End Function

Public Function Init(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
    
    '----装载此业务对象的元数据（EntityObject）
    Set objEO = objDataMgr.LoadEOMetaData(DataSourceName, BIStyle)
    
    '----申请OID
    Set objEO.OID = objOIDMgr.GetNewOID(DataSourceName, BIStyle)
    
    Set Init = objEO
    
    Set objOIDMgr = Nothing
    Set objDataMgr = Nothing
    Set objEO = Nothing
End Function

Public Function Save(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 OIDManager
    
    '----验证
    If Not Validate(DataSourceName, EO) Then Exit Function
    
    '----得到OID
    If EO.State = esoAddNew Then
        Set EO.OID = objOIDMgr.GetNewOID(DataSourceName, m_conBIStyle, True)
    End If
    
    '----存盘
    If con.State = adStateClosed Then con.Open DataSourceName
    If Not objDataMgr.Save(con, EO) Then Exit Function
    
    Set objDataMgr = Nothing
    
    Save = True

    Set objOIDMgr = Nothing
    Set objDataMgr = Nothing
End Function

Private Function Validate(DataSourceName As String, EO As U8FDEso.EntityObject) As Boolean
    Select Case EO.State
        Case esoDelete              '----删除前验证
        
        Case esoAddNew, esoEdit     '----保存前验证
        
    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 Delete(DataSourceName As String, EO As U8FDEso.EntityObject, Optional ByVal BIStyle As Long = m_conBIStyle) As Boolean
    Dim objDataMgr As New U8FDmgr.DataManager

    '----验证
    If Not Validate(DataSourceName, EO) Then

    End If
    
    '----加锁
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    '----删除
    objDataMgr.Delete con, EO
    
    '----解锁
    Delete = True
    
    Set objDataMgr = Nothing
End Function

Public Function LoadEOs(DataSourceName As String, Optional BIStyle As Integer = m_conBIStyle) 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
    sql = "Select * From FD_Entities Where iBIType =" & BIStyle
    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 LoadEOs = objEOs
    
    Set objEO = Nothing
    Set objEOs = 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 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("cad_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
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    sql = "select 1 from fd_accdef where cad_id = '" & ID & "'"
    sql = sql & " union select 1 from fd_accdef where yt_cad_id = '" & ID & "'"
    sql = sql & " union select 1 from fd_transactions where cad_id = '" & ID & "'"
    
    rec.Open sql, con
    
    If Not rec.EOF Then
        IsUsed = True
    Else
        IsUsed = False
    End If
    
    rec.Close
    Set rec = Nothing
End Function