datamanager.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 = "DataManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'--------------------------------
'时间:2001.11.12
'版权:北京用友软件股份有限公司
'设计:章景峰
'编码:章景峰
'说明:U8资金管理---数据对象
'--------------------------------
Option Explicit

Public Function MoveTo(con As ADODB.Connection, EO As U8FDEso.EntityObject, MoveMode As U8FDEso.MoveModeEnum, Optional Reversal As Boolean = False) As Boolean
    Dim sql         As String
    Dim rec         As New ADODB.Recordset
    Dim recChild    As New ADODB.Recordset
    Dim objChildEO  As U8FDEso.EntityObject
    Dim objFO       As U8FDEso.FieldObject
    
    '----建立数据库连接，并拼写SQL语句
    Select Case MoveMode
        Case esoCurrent
            sql = "Select * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " = '" & EO.OID.ID & "'"
        Case esoFirst
            sql = "Select Top 1 * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' Order By " & EO.SourceOIDField & " ASC"
        Case esoLast
            sql = "Select Top 1 * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' Order By " & EO.SourceOIDField & " DESC"
        Case esoNext
            sql = "Select Top 1 * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' And " & EO.SourceOIDField & " > '" & EO.OID.ID & "' Order By " & EO.SourceOIDField & " ASC"
        Case esoPrevious
            sql = "Select Top 1 * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' And " & EO.SourceOIDField & " < '" & EO.OID.ID & "' Order By " & EO.SourceOIDField & " DESC"
    End Select
        
    '----打开结果集
    rec.Open sql, con, adOpenStatic, adLockOptimistic
    
    '----如果未发现记录且Reversal为True，Then翻转
    
    If rec.EOF Then
'        MsgBox "已经翻到头了，请向相反的方向翻页！", vbInformation, "资金管理"
        Set rec = Nothing
        If Reversal Then
            sql = "Select Top 1 * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " Like '" & Right("0" & EO.BIType, 2) & "%' Order By " & EO.SourceOIDField & IIf(MoveMode = esoNext, " ASC", " DESC")
        Else 'If Not Reversal Then
            sql = "Select * From " & EO.SourceTable & " Where " & EO.SourceOIDField & " = '" & EO.OID.ID & "'"
        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.Item(objFO.SourceField)
            End If
        Next
        
        '----成功后，置State为esoInstance
        EO.State = esoInstance
        
        '----装载子表数据
        If Not EO.EOS.EOMetaData Is Nothing Then
'            If Not EO.OID Is Nothing And EO.OID <> "" Then
'                EO.EOS.EOMetaData.ParentOID.ID = EO.OID.ID
'            Else
                EO.EOS.EOMetaData.ParentOID.ID = rec(EO.SourceOIDField)
'            End If
            sql = "Select * From " & EO.EOS.EOMetaData.SourceTable & " Where " & EO.EOS.EOMetaData.ParentField & " = '" & EO.EOS.EOMetaData.ParentOID.ID & "'"
            recChild.Open sql, con
            While Not recChild.EOF
                '----
                Set objChildEO = EO.EOS.EOMetaData.Clone
                
                '----
                For Each objFO In objChildEO.Fields
'                For i = 1 To objChildEO.Fields.Count
'                    Set objFO = objChildEO.Fields.Item(i)
                    If objFO.Persistent And objFO.IsUsed Then
                        objFO.Value = recChild.Fields.Item(objFO.SourceField)
                    End If
                Next
                
                '----成功后，置State为esoInstance
                objChildEO.State = esoInstance
                
                '----
                If Not objChildEO.EOS.EOMetaData Is Nothing Then
                    MoveTo con, objChildEO, esoCurrent
                End If
                
                '----
                EO.EOS.Append objChildEO, "K" & objChildEO(objChildEO.SourceOIDField)
                
                recChild.MoveNext
            Wend
            
            recChild.Close
            Set recChild = Nothing
        End If
    End If
    
    rec.Close
    Set rec = Nothing
    
    Set objFO = Nothing
    Set objChildEO = Nothing
    
    MoveTo = True
End Function

Public Function MoveToBySQL(DataSourceName As String, sql As String) As String
    Dim rec         As New ADODB.Recordset
    
    If con.State = adStateClosed Then con.Open DataSourceName
    rec.Open sql, con, adOpenStatic, adLockOptimistic
    
    If rec.EOF Then
        MoveToBySQL = 0
    Else
        MoveToBySQL = rec.Fields(1).Value
    End If
    
    rec.Close
    Set rec = Nothing
End Function

Public Function Delete(con As ADODB.Connection, EO As U8FDEso.EntityObject) As Boolean
    Dim sql         As String
    Dim objChildEO  As U8FDEso.EntityObject
    
    If Not EO.EOS.EOMetaData Is Nothing Then
        If Not EO.EOS.EOMetaData.EOS.EOMetaData Is Nothing Then
            For Each objChildEO In EO.EOS
                Delete con, objChildEO
            Next
        Else
            sql = "Delete From " & EO.EOS.EOMetaData.SourceTable & " Where " & EO.EOS.EOMetaData.ParentField & " = '" & EO(EO.SourceOIDField) & "'" '最末一级EO.EOS.EOMetaData.ParentOID.ID
            con.Execute sql
        End If
    End If
    
    sql = "Delete From " & EO.SourceTable & " Where " & EO.SourceOIDField & " = '" & EO(EO.SourceOIDField) & "'" '最上一级'EO.OID.ID
    con.Execute sql
    
    Set objChildEO = Nothing
    Delete = True
End Function

Public Function DeleteBIType(con As ADODB.Connection, ByVal BIStyle As Long) As Boolean
    Dim sql As String
    
    sql = "Delete From fd_fields where iEntityID = '" & BIStyle & " '"
    con.Execute sql
    
'    sql = "Delete From FD_Entities Where iDeriveBIType = '" & BIStyle & " '"
'    con.Execute sql
    
    sql = "Delete From FD_Entities Where iBIType = '" & BIStyle & " '"
    con.Execute sql
    
    DeleteBIType = True
End Function

Public Function Save(con As ADODB.Connection, EO As U8FDEso.EntityObject) As Boolean
    Dim sql         As String
    Dim sFields     As String
    Dim sValues     As String
    Dim vValue      As Variant
    Dim objFO       As U8FDEso.FieldObject
    Dim objChildEO  As U8FDEso.EntityObject
    Dim recChild    As New ADODB.Recordset
    
    On Error GoTo lblHandle
    
    Save = False

    Select Case EO.State
        '----新增
        Case esoAddNew
            For Each objFO In EO.Fields
'            For i = 1 To EO.Fields.Count
'                Set objFO = EO.Fields.Item(i)
                '----已使用并需要持久化
                If objFO.Persistent And objFO.IsUsed Then
                    '----处理Value值
                    vValue = objFO.Value
                    If IsEmpty(vValue) Or IsNull(vValue) Then
                        vValue = objFO.DefaultValue
                    End If
        
                    '----取字段名称
                    sFields = sFields & objFO.SourceField & ", "
        
                    '----取值
                    If IsEmpty(objFO.Value) Or IsNull(objFO.Value) Then
                        sValues = sValues & "NULL, "
                    Else
                        Select Case objFO.DataType
                            '----字符型
                            Case esoString, esoID, esoMemo
                                sValues = sValues & "'" & vValue & "', "
                            
                            '----日期型
                            Case esoDate
                                sValues = sValues & "'" & vValue & "', "
                            
                            '----布尔型
                            Case esoBoolean
                                sValues = sValues & CByte(vValue) / 255 & ", "
                            
                            '----数值型
                            Case esoLong, esoCurrency, esoDouble
                                sValues = sValues & vValue & ", "
                        
                        End Select
                    End If
                End If
            Next
            
            sFields = Left(sFields, Len(sFields) - 2)
            sValues = Left(sValues, Len(sValues) - 2)
        
            '----拼写SQL语句
            sql = "Insert Into " & EO.SourceTable & " "
            sql = sql & "(" & sFields & ") Values (" & sValues & ");"
        '----编辑
        Case esoEdit
            For Each objFO In EO.Fields
'            For i = 1 To EO.Fields.Count
'                Set objFO = EO.Fields.Item(i)
                '----已使用并需要持久化
                If objFO.Persistent And objFO.IsUsed Then
                    '----处理Value值
                    vValue = objFO.Value
                    If IsEmpty(vValue) Or IsNull(vValue) Then
                        vValue = objFO.DefaultValue
                    End If
        
                    '----取值
                    Select Case objFO.DataType
                        '----字符型
                        Case esoString, esoID, esoMemo
                            If IsNull(objFO.Value) Then
                                sValues = sValues & objFO.SourceField & " = NULL, "
                            Else
                                sValues = sValues & objFO.SourceField & " = '" & vValue & "', "
                            End If
                        
                        '----日期型
                        Case esoDate
                            If IsNull(objFO.Value) Then
                                sValues = sValues & objFO.SourceField & " = NULL, "
                            Else
                                sValues = sValues & objFO.SourceField & " = '" & vValue & "', "
                            End If
                        
                        '----布尔型
                        Case esoBoolean
                            sValues = sValues & objFO.SourceField & " = " & CByte(vValue) / 255 & ", "
                        
                        '----数值型
                        Case esoLong, esoCurrency, esoDouble
                            If IsNull(objFO.Value) Then
                                sValues = sValues & objFO.SourceField & " = NULL, "
                            Else
                                sValues = sValues & objFO.SourceField & " = " & vValue & ", "
                            End If
                    End Select
                End If
            Next
        
            sValues = Left(sValues, Len(sValues) - 2)
        
            '----拼写SQL语句
            sql = "Update " & EO.SourceTable & " Set "
            sql = sql & sValues & " Where " & EO.SourceOIDField & " = '" & EO.OID.ID & "'"
    End Select

    '----执行
    Dim iAffectedRecords As Long
    
    If sql <> "" Then
        con.Execute sql, iAffectedRecords
        If iAffectedRecords = 0 Then
            Err.Raise ErrNoUpdatedRecords, , "本次提交没有更新记录!"
        End If
    End If
    
    '----存储子表信息
    If Not EO.EOS.EOMetaData Is Nothing Then
        '----删除子表中的记录
        EO.EOS.EOMetaData.ParentOID.ID = EO.OID.ID
        If EO.BIType <> 1 Then
            sql = "Delete From " & EO.EOS.EOMetaData.SourceTable & " Where " & EO.EOS.EOMetaData.ParentField & " = '" & EO.EOS.EOMetaData.ParentOID.ID & "'"
            con.Execute sql
        ElseIf EO.State = esoAddNew Or EO.State = esoEdit Then '账户定义，入帐科目
            sql = "Delete From " & EO.EOS.EOMetaData.SourceTable & " Where " & EO.EOS.EOMetaData("type_flag").SourceField & "<>0 and " & EO.EOS.EOMetaData.ParentField & " = '" & EO.EOS.EOMetaData.ParentOID.ID & "'"
            con.Execute sql
        End If
       
        '----准备批量更新数据
        recChild.Open EO.EOS.EOMetaData.SourceTable, con, adOpenKeyset, adLockBatchOptimistic, adCmdTable
        For Each objChildEO In EO.EOS
            recChild.AddNew
            For Each objFO In objChildEO.Fields
                If objFO.Persistent And objFO.IsUsed Then
                    If objFO.SourceField = EO.EOS.EOMetaData.ParentField Then
                        recChild.Fields.Item(objFO.SourceField) = EO.EOS.EOMetaData.ParentOID.ID
                    ElseIf objFO.DataType = esoBoolean Then