clsaccdefbi.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 = "clsAccDefBI"
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 = 1

'得到账户余额
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) As U8FDEso.EntityObject
    Dim objEO      As U8FDEso.EntityObject
    Dim objDataMgr As New U8FDmgr.DataManager
    
    If con.State = adStateClosed Then con.Open DataSourceName

    '----装载此业务对象的元数据（EntityObject）
    Set objEO = objDataMgr.LoadEOMetaData(DataSourceName, BIStyle)

    '----赋oid值
    If Not OID Is Nothing Then Set objEO.OID = OID
    
    objDataMgr.MoveTo con, objEO, MoveMode, False

    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, True)
    
    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
    
    If EO.State = esoAddNew Then
        Set EO.OID = objOIDMgr.GetNewOID(DataSourceName, BIStyle)
    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
       
    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
    Dim sql        As String
    
    '----验证
    If Not Validate(DataSourceName, EO) Then

    End If
    
    '----加锁
    
    If con.State = adStateClosed Then con.Open DataSourceName
    sql = "Delete from fd_accgrplnk where accdef_id='" & EO("accdef_id") & "'"
    con.Execute sql

    '----删除
    objDataMgr.Delete con, EO
    
    '----解锁
    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 ID
    rec.Open "Select " & objEO.SourceOIDField & " From " & objEO.SourceTable & " Where " & objEO("accdef_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 FindByUnit(DataSourceName As String, UnitID As String, Optional ByVal BIStyle As Long = m_conBIStyle) As String
    Dim objEO      As U8FDEso.EntityObject
    Dim rec        As New ADODB.Recordset
    
    Set objEO = Init(DataSourceName)
    
    If con.State = adStateClosed Then con.Open DataSourceName
    '----Get Oid from ID
    rec.Open "Select " & objEO.SourceOIDField & " From " & objEO.SourceTable & " Where " & objEO("accunit_id").SourceField & " = '" & UnitID & "'", con
    
    If Not rec.EOF Then
        FindByUnit = rec.Fields(objEO.SourceOIDField)
    Else
        FindByUnit = ""
    End If
    
    rec.Close
    Set rec = Nothing
    
    Set objEO = Nothing
End Function

Public Function LoadAllRecordByAccUnit(ByVal DataSourceName As String, Optional ByVal BIStyle As Long = m_conBIStyle, Optional OID As U8FDEso.OIDObject) As U8FDEso.Entities
    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 LoadAllRecordByAccUnit = objEO.EOS
    
    Set objOID = Nothing
    Set objEO = Nothing
    Set objDataMgr = Nothing
    Set objOIDMgr = 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 Find(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, sqlclause As String) As String
    Dim sql         As String
    Dim rec         As New ADODB.Recordset
    
    If con.State = adStateClosed Then con.Open DataSourceName
    sql = "Select " & EO("accdef_id").SourceField & " From " & EO.SourceTable & " where 1=1" & sqlclause
    
    sql = sql & " order by " & EO("accdef_id").SourceField
    
    rec.Open sql, con, adOpenStatic, adLockOptimistic
    
    If Not rec.EOF Then
        Find = rec.Fields(0).Value
    Else
        Find = 0
    End If
    
    rec.Close
    Set rec = Nothing
End Function

Public Function FindGrp(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, sqlclause As String) As String
    Dim sql         As String ', Optional accgrp_id As String
    Dim rec         As New ADODB.Recordset
    Dim recgrp      As New ADODB.Recordset
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    sql = "Select " & EO("accdef_id").SourceField & " From " & EO.SourceTable & " where 1=1" & sqlclause
    
    sql = sql & " order by " & EO("accdef_id").SourceField
    
    rec.Open sql, con, adOpenStatic, adLockOptimistic
    
    If Not rec.EOF Then
        sql = "Select * From " & "fd_accgrplnk where " & EO.SourceOIDField & "='" & rec.Fields(0).Value & "'"
        recgrp.Open sql, con, adOpenStatic, adLockOptimistic
        If Not recgrp.EOF Then
            FindGrp = rec.Fields(0).Value & "|" & recgrp.Fields(0).Value
        Else
            FindGrp = rec.Fields(0).Value
        End If
    Else
        FindGrp = 0
    End If
    
    rec.Close
    Set rec = 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_transactions where rcv_acc_id = '" & ID & "'"
    sql = sql & " or pay_acc_id = '" & ID & "'"
    sql = sql & " or fixed_acc_id = '" & ID & "'"
    sql = sql & " or minus_acc_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

Public Function GetSubjectByAccID(DataSourceName As String, ID As String, Optional ByVal BIStyle As Long = m_conBIStyle) As String
    Dim rec As New ADODB.Recordset
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    rec.Open "Select cCode From fd_accset Where accdef_id = '" & ID & "' and type_flag=1", con
    
    If Not rec.EOF Then
        GetSubjectByAccID = rec.Fields(0)
    Else
        GetSubjectByAccID = ""
    End If
    
    rec.Close
    Set rec = Nothing
End Function