clsaccgrpbi.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 = "clsAccGrpBI"
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 = 2

'得到账户余额
Public Function GetBalance(DataSourceName As String, ID As String, dEnd As Date) As Double
    Dim rec As New ADODB.Recordset

    OpenConnection con, DataSourceName
    If Not OpenRecordset(con, rec, "Select * From fd_accdef Where accdef_id = '" & ID & "'") Then
       'Err.Raise 该账户不存在
    End If
    GetBalance = IIf(IsNull(rec.Fields(0).Value), 0, rec.Fields(0).Value)

    CloseRec rec
    
    Set rec = Nothing
End Function

'得到账户积数
Public Function GetAccumulate(DataSourceName As String, ID As String, dEnd As Date) As Double
    Dim rec As New ADODB.Recordset

    OpenConnection con, DataSourceName
    If Not OpenRecordset(con, rec, "Select * From fd_accdef Where accdef_id = '" & ID & "'") Then
       'Err.Raise 该账户不存在
    End If
    GetAccumulate = IIf(IsNull(rec.Fields(0).Value), 0, rec.Fields(0).Value)

    CloseRec rec
    
    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, Optional ByVal ParentID As String) As U8FDEso.EntityObject
    Dim objEO      As U8FDEso.EntityObject
    Dim objDataMgr As New U8FDmgr.DataManager
    
    '----装载此业务对象的元数据（EntityObject）
    Set objEO = objDataMgr.LoadEOMetaData(DataSourceName, BIStyle)

    '----赋oid值
    If Not OID Is Nothing Then Set objEO.OID = OID
    
    '----
    If MoveTo_Grp(DataSourceName, objEO, MoveMode, ParentID) Then
        Set MoveTo = objEO
    Else
        Set MoveTo = objEO 'Nothing
    End If
    
    Set objDataMgr = Nothing
    Set objEO = Nothing
End Function
'删除账户组时用到
Private Function MoveTo_Grp(DataSourceName As String, EO As U8FDEso.EntityObject, MoveMode As U8FDEso.MoveModeEnum, Optional ByVal ParentID As String) As Boolean
    Dim sql        As String
    Dim rec        As New ADODB.Recordset
    Dim objFO      As U8FDEso.FieldObject
    
    '----建立数据库连接，并拼写SQL语句
    If con.State = adStateClosed Then con.Open DataSourceName
    Select Case MoveMode
        Case esoCurrent
            sql = "Select * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " = '" & EO.OID & "'"
        Case esoFirst
            If IsNull(ParentID) Or ParentID = "" Then
                sql = "Select Top 1 * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' Order By " & EO("parent_id").SourceField & "," & EO("accgrp_id").SourceField & " ASC"
            Else
                sql = "Select Top 1 * from " & EO.SourceTable & " where " & EO("parent_id").SourceField & "='" & ParentID & "' and " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' And " & EO.SourceOIDField & " > '" & EO.OID & "' order by " & EO("accgrp_id").SourceField & ""
            End If
        Case esoLast
            sql = "Select Top 1 * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' Order By " & EO("parent_id").SourceField & "," & EO("accgrp_id").SourceField & " DESC"
        Case esoNext
            'sql = "Select Top 1 * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' And " & EO.SourceOIDField & " > '" & EO(EO.SourceOIDField) & "' Order By " & EO("parent_id").SourceField & "," & EO("accgrp_id").SourceField & " ASC"
            If IsNull(ParentID) Or ParentID = "" Then
                sql = "Select Top 1 * from " & EO.SourceTable & " where " & EO("parent_id").SourceField & " is Null  and " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' And " & EO.SourceOIDField & " > '" & EO.OID & "' order by " & EO("accgrp_id").SourceField & ""
            Else
                sql = "Select Top 1 * from " & EO.SourceTable & " where " & EO("parent_id").SourceField & "='" & ParentID & "' and " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' And " & EO.SourceOIDField & " > '" & EO.OID & "' order by " & EO("accgrp_id").SourceField & ""
            End If
        Case esoPrevious
            sql = "Select Top 1 * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' And " & EO.SourceOIDField & " < '" & EO.OID & "' Order By " & EO("parent_id").SourceField & "," & EO("accgrp_id").SourceField & " DESC"
    End Select
    
    '----打开结果集
    rec.Open sql, con, adOpenStatic, adLockOptimistic
    
    '----
    If rec.EOF Then
        Set rec = Nothing
        'sql = "Select Top 1 * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' Order By " & EO("parent_id").SourceField & "," & EO.SourceOIDField
        If IsNull(ParentID) Or ParentID = "" Then
            sql = "Select Top 1 * from " & EO.SourceTable & " where " & EO("parent_id").SourceField & " is Null  and " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' And " & EO.SourceOIDField & " < '" & EO.OID & "' order by " & EO.SourceOIDField & ""
        Else
            sql = "Select Top 1 * from " & EO.SourceTable & " where " & EO("parent_id").SourceField & "='" & ParentID & "' and " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' And " & EO.SourceOIDField & " < '" & EO.OID & "' order by " & EO.SourceOIDField & ""
        End If
        rec.Open sql, con, adOpenStatic, adLockOptimistic
    End If
    
    If Not rec.EOF Then
        For Each objFO In EO.Fields
            If objFO.Persistent And objFO.IsUsed Then
                objFO.Value = rec.Fields(objFO.SourceField)
            End If
        Next
        
        '----成功后，置State为esoInstance
        EO.State = esoInstance
    Else
        If ParentID <> "" Then ' MoveTo_Grp DataSourceName, EO, MoveMode, ParentID
            Set rec = Nothing
            sql = "Select * from " & EO.SourceTable & " where " & EO.SourceOIDField & "='" & ParentID & "'"
            rec.Open sql, con, adOpenStatic, adLockOptimistic
            If Not rec.EOF Then
                For Each objFO In EO.Fields
                    If objFO.Persistent And objFO.IsUsed Then
                        objFO.Value = rec.Fields(objFO.SourceField)
                    End If
                Next
                
                '----成功后，置State为esoInstance
                EO.State = esoInstance
            End If
        Else
            rec.Close
            Set rec = Nothing
            
            MoveTo_Grp = False
            Exit Function
        End If
    End If
    
    rec.Close
    Set rec = Nothing
    
    MoveTo_Grp = True
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 U8FDmgr.OIDManager
    
    '----验证
    If Not Validate(DataSourceName, EO) Then Exit Function
    
    '----得到OID
    If EO.State = esoAddNew Then
        Set EO.OID = objOIDMgr.GetNewOID(DataSourceName, BIStyle, True)
    End If
    
    '----存盘
    If con.State = adStateClosed Then con.Open DataSourceName
    
    con.BeginTrans
    If Not objDataMgr.Save(con, EO) Then Exit Function
    con.CommitTrans
    
    Save = True
    
    Set objOIDMgr = Nothing
    Set objDataMgr = Nothing
End Function

Private Function Validate(DataSourceName As String, EO As U8FDEso.EntityObject) As Boolean
    Dim rec As New ADODB.Recordset
    Dim sql As String
    
    Select Case EO.State
        Case esoDelete              '----删除前验证
        
        Case esoAddNew, esoEdit     '----保存前验证
            If con.State = adStateClosed Then con.Open DataSourceName
            sql = "Select count(*) from " & EO.SourceTable & " where " & EO("accgrp_id").SourceField & "<>'" & EO("accgrp_id") & "' and " & EO("accgrp_code").SourceField & "='" & EO("accgrp_code") & "'"
            If Not IsNull(EO("parent_id").Value) Then
                sql = sql & " and " & EO("parent_id").SourceField & "='" & EO("parent_id").Value & "'"
            Else
                sql = sql & " and " & EO("parent_id").SourceField & " is null"
            End If
            rec.Open sql, con, adOpenDynamic, adLockReadOnly
            If rec.Fields(0) > 0 Then
                MsgBox "同一类型下代码不能重复!"
                Validate = False
                rec.Close
                Exit Function
            End If
            rec.Close
    End Select
    
    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
    Dim objEO       As U8FDEso.EntityObject
    Dim objOID      As New U8FDEso.OIDObject
    Dim i           As Integer
    Dim RecCount    As Long
    
    RecCount = RecordCount(DataSourceName, EO, EO(EO.SourceOIDField))
    If RecCount > 0 Then '如果有子节点，先删除
        Set objEO = MoveTo(DataSourceName, esoFirst, , , EO(EO.SourceOIDField))
        Delete DataSourceName, objEO
        For i = 1 To RecCount
            If i < RecCount Then
                objOID = objEO(objEO.SourceOIDField)
                Set objEO = MoveTo(DataSourceName, esoNext, , objOID, EO(EO.SourceOIDField))
                Delete DataSourceName, objEO
            End If
        Next
    End If
    
    'If Not DeleteOID(DataSourceName, EO(EO.SourceOIDField), FirstChildNode) Then
    '    MsgBox "删除不成功!"
    '    Exit Function
    'End If
    
    If con.State = adStateClosed Then con.Open DataSourceName
    '----应该先加锁，再删除
    objDataMgr.Delete con, EO
    
    Dim sql As String
    sql = "delete from fd_accgrplnk where " & EO.SourceOIDField & "='" & EO(EO.SourceOIDField) & "'"
    con.Execute sql
    
    '----解锁
    Delete = True
    
    Set objDataMgr = 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 Code
    rec.Open "Select " & objEO.SourceOIDField & " From " & objEO.SourceTable & " Where " & objEO("accgrp_code").SourceField & " = '" & Code & "'", con
    If Not rec.EOF Then
        '----赋oid值
        objOID = rec.Fields(objEO.SourceOIDField)
        Set objEO.OID = objOID
    Else
        Err.Raise vbObjectError + 3001, , "当前账户不存在！"
    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 RecordCount(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, Optional ByVal ParentID As String)
    Dim sql         As String
    Dim rec         As New ADODB.Recordset
    
    If con.State = adStateClosed Then con.Open DataSourceName
    If IsNull(ParentID) Or ParentID = "" Then
        sql = "Select count(*) From " & EO.SourceTable & " where " & EO("parent_id").SourceField & " is null"
    Else
        sql = "Select count(*) From " & EO.SourceTable & " where " & EO("parent_id").SourceField & "='" & ParentID & "'"
    End If
    
    rec.Open sql, con, adOpenStatic, adLockOptimistic
    
    RecordCount = rec.Fields(0).Value
    
    rec.Close
    Set rec = Nothing
End Function