clsvchdefbi.cls

财务信息管理系统,适合做毕业论文的人使用

    
    Set prmDeleteFields = Nothing
    Set cmdDeleteFields = Nothing
    Set objDataMgr = Nothing
End Function

Public Function BITypeIsUsed(ByVal DataSourceName As String, ByVal BIStyle As Long) As Boolean
    Dim rec As New ADODB.Recordset
    Dim sql As String
    
    If con.State = adStateClosed Then con.Open DataSourceName
    sql = "select count(*) From fd_transactions where substring(transactions_id,1,2) = '" & BIStyle & " '"
    rec.Open sql, con, adOpenKeyset, adLockReadOnly
    If rec.Fields(0) > 0 Then
        BITypeIsUsed = True
    Else
        BITypeIsUsed = False
    End If
    rec.Close
    Set rec = Nothing
End Function

Public Function VouchIsUsed(ByVal DataSourceName As String, ByVal BIStyle As Long) As Boolean
    Dim rec As New ADODB.Recordset
    Dim sql As String
    
    If con.State = adStateClosed Then con.Open DataSourceName
    sql = "select count(*) From FD_Vouch where substring(cBus_id,1,2) = '" & BIStyle & " '"
    rec.Open sql, con, adOpenKeyset, adLockReadOnly
    If rec.Fields(0) > 0 Then
        VouchIsUsed = True
    Else
        VouchIsUsed = False
    End If
    rec.Close
    Set rec = Nothing
End Function

Public Function VouchIsCreated(ByVal DataSourceName As String, ByVal Code As String) As Boolean
    Dim rec As New ADODB.Recordset
    Dim sql As String
    
    If con.State = adStateClosed Then con.Open DataSourceName
    sql = "select count(*) From FD_Vouch where cBus_id = '" & Code & " '"
    rec.Open sql, con, adOpenKeyset, adLockReadOnly
    If rec.Fields(0) > 0 Then
        VouchIsCreated = True
    Else
        VouchIsCreated = False
    End If
    rec.Close
    Set rec = Nothing
End Function

Public Function Validate(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, ByVal BIStyle As Long) As Boolean
    Select Case EO.State
        Case esoAddNew
        
        Case esoDelete
        
        Case esoEdit
        
        Case esoInitialized
        
        Case esoInstance
        
    End Select
    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 = esoInstance
            .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)
            .VchType = IIf(IsNull(rec!iVchType), "", rec!iVchType)
            .DeriveBIType = rec!iDeriveBIType
            .IsAutoAlarm = IIf(IsNull(rec!bIsAutoAlarm), 0, rec!bIsAutoAlarm)
            .AlarmDays = IIf(IsNull(rec!iAlarmDays), 0, rec!iAlarmDays)
        End With
        
        'If rec!iDeriveBIType = 0 Then
            objEOs.Append objEO, "K" & rec!iBIType
        'Else
        '    objEOs.Append objEO, "K" & rec!iDeriveBIType & rec!iBIType
        'End If
        
        rec.MoveNext
    Loop
    
    rec.Close
    Set rec = Nothing
    
    Set LoadVchEOs = objEOs
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
    
    Set objDataMgr = Nothing
    SaveVchEOs = True
End Function

Public Function CopyFields(DataSourceName As String, FromBIType As Long, ToBIType As Long) As Boolean
    Dim sql           As String
    Dim objDataMgr    As New U8FDmgr.DataManager
    Dim cmdCopyFields As ADODB.Command
    Dim prmCopyFields As ADODB.Parameter
    
    On Error GoTo lblError
    
    If con.State = adStateClosed Then con.Open DataSourceName
    
    con.BeginTrans
    
    Set cmdCopyFields = New ADODB.Command
    Set cmdCopyFields.ActiveConnection = con
    cmdCopyFields.CommandText = "FD_CopyFields"
    cmdCopyFields.CommandType = adCmdStoredProc
    cmdCopyFields.CommandTimeout = 15
    
    Set prmCopyFields = New ADODB.Parameter
    Set prmCopyFields = cmdCopyFields.CreateParameter("FromBIType", adInteger, adParamInput, 1, FromBIType)
    cmdCopyFields.Parameters.Append prmCopyFields
    Set prmCopyFields = cmdCopyFields.CreateParameter("ToBIType", adInteger, adParamInput, 1, ToBIType)
    cmdCopyFields.Parameters.Append prmCopyFields
    
    cmdCopyFields.Execute
    
lblOnlyEO:
    con.CommitTrans
    
    Set prmCopyFields = Nothing
    Set cmdCopyFields = Nothing
    
    Set objDataMgr = Nothing
    
    CopyFields = True
    
    Exit Function
    
lblError:
    con.RollbackTrans
End Function

Public Function GetAccBalance(DataSourceName As String, EO As U8FDEso.EntityObject, AccID As String) As Currency
'    Dim rec As New ADODB.Recordset
'    Dim sql As String
'
'    con.Open DataSourceName
'
'    Dim sqlQc As String
'    Dim rsQc As New UfRecordset
'    Dim sqlItem As String
'    Dim rsDataSrc As New UfRecordset
'
'    Set rsDataSrc = dbsZJ.OpenRecordset("SELECT * FROM FD_AccDef WHERE cAccID='" & strAccID & "'", dbOpenSnapshot)
'    iDataSource = rsDataSrc!iDataSrc
'     If iDataSource = 0 Then    '资金系统
'        sqlItem = Nbzh_sql
'        '求期初余额+发生
'        sqlQc = "SELECT mb FROM FD_AccDef WHERE cAccID='" & strAccID & "'"
'        Set rsQc = dbsZJ.OpenRecordset(sqlQc, dbOpenSnapshot)
'        dzdMb = IIf(IsNull(rsQc!Mb), 0, rsQc!Mb)
'        dzdMb = dzdMb + GetZhYe(strAccID, datDate)
'     Else                          '账务系统
'        dzdMb = Cal_Wbzh(sqlItem)
'     End If
'
'     Set rsDisplay = dbsZJ.OpenRecordset(sqlItem, dbOpenSnapshot)
'
'
'       Dim i As Long, j As Long, blnPrpty As Boolean
'       Dim sqlClass As String, rsClass As New UfRecordset, strClass As String
'       Dim curMb As Double
'
'       If iDataSource = 1 Then blnPrpty = IIf(ZhDir = 1, True, False)
'       With rsDisplay
'       If .RecordCount = 0 Then
'          UfGridADO1.AddItem "" & Chr(9) & "上日余额:"
'          UfGridADO1.TextMatrix(2, IIf(iDataSource = 0, 4, 11)) = IIf(dzdMb = 0, "", IIf(iDataSource = 0, FormatCur(dzdMb), FormatCur(Abs(dzdMb))))
'          UfGridADO1.AddItem "" & Chr(9) & "本日合计:"
'          UfGridADO1.TextMatrix(3, IIf(iDataSource = 0, 4, 11)) = IIf(dzdMb = 0, "", IIf(iDataSource = 0, FormatCur(dzdMb), FormatCur(Abs(dzdMb))))
'          If iDataSource = 1 Then
'             UfGridADO1.TextMatrix(2, 10) = ExcJd(IIf(blnPrpty, "借", "贷"), dzdMb)
'             UfGridADO1.TextMatrix(3, 10) = ExcJd(IIf(blnPrpty, "借", "贷"), dzdMb)
'          End If
'          UfGridADO1.Row = 2
'          UfGridADO1.Col = 0
'          Exit Function
'       End If
'       .MoveFirst
'       i = 0: j = 0
'       If iDataSource = 1 Then
'          With pzZhye
'             ReDim .iBook(nMaxRows - nFixRows)
'             ReDim .iPeriod(nMaxRows - nFixRows)
'             ReDim .cSign(nMaxRows - nFixRows)
'             ReDim .iNo_id(nMaxRows - nFixRows)
'          End With
'          ReDim cItemClass(nMaxRows)
'       End If
'       While Not .EOF
'          If iDataSource = 0 Then
'             If i = 0 Then
'    '            UfGridADO1.AddItem "" & Chr(9) & "上日余额:" & Chr(9) & "" & _
'                 Chr(9) & "" & Chr(9) & Format(dzdMb, "#,##0.00")                    'Cuidong 2000/08/04
'                UfGridADO1.AddItem "" & Chr(9) & "上日余额:" & Chr(9) & "" & _
'                Chr(9) & "" & Chr(9) & IIf(dzdMb = 0, "", Format(dzdMb, "#,##0.00")) 'Cuidong 2000/08/04
'                j = j + 1
'                curMb = dzdMb + IIf(IsNull(!Field2), 0, !Field2) - IIf(IsNull(!Field3), 0, !Field3)
'             Else
'                curMb = curMb + IIf(IsNull(!Field2), 0, !Field2) - IIf(IsNull(!Field3), 0, !Field3)
'             End If
'             sqlClass = "SELECT * FROM FD_Class WHERE csign='" & Left(!Field0, 2) & "'"
'             Set rsClass = dbsZJ.OpenRecordset(sqlClass, dbOpenSnapshot)
'             UfGridADO1.AddItem rsClass!ctext & "-" & _
'                Right(!Field0, Len(!Field0) - 2) & Chr(9) & _
'                !Field1 & Chr(9) & _
'                IIf(!Field2 = 0, "", FormatCur(!Field2)) & Chr(9) & _
'                IIf(!Field3 = 0, "", FormatCur(!Field3))
'             UfGridADO1.TextMatrix(nFixRows + j, 4) = FormatCur(curMb)
'             j = j + 1
'          Else
'             If i = 0 Then
'                UfGridADO1.AddItem "" & Chr(9) & "上日余额:" & Chr(9) & "" & _
'                   Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & _
'                   Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & Chr(9) & "" & _
'                   Chr(9) & IIf(dzdMb = 0, "", FormatCur(Abs(dzdMb)))
'                j = j + 1
'                UfGridADO1.TextMatrix(2, 10) = ExcJd(IIf(blnPrpty, "借", "贷"), dzdMb)
'                curMb = dzdMb + IIf(blnPrpty, !Field8 - !Field9, !Field9 - !Field8)
'             Else
'                curMb = curMb + IIf(blnPrpty, !Field8 - !Field9, !Field9 - !Field8)
'             End If
'             UfGridADO1.AddItem !Fieldx & "-" & Right("000" & !Field0, 4) & Chr(9) & _
'                !Field1 & Chr(9) & _
'                !Field2 & Chr(9) & _
'                !Field3 & Chr(9) & _
'                !Field4 & Chr(9) & _
'                !Field5 & Chr(9) & _
'                !Field6 & Chr(9) & _
'                !Field11 & Chr(9) & _
'                IIf(!Field8 = 0, "", FormatCur(!Field8)) & Chr(9) & _
'                IIf(!Field9 = 0, "", FormatCur(!Field9)) & Chr(9)
'
'             UfGridADO1.TextMatrix(nFixRows + j, 10) = ExcJd(IIf(blnPrpty, "借", "贷"), curMb)
'             UfGridADO1.TextMatrix(nFixRows + j, 11) = IIf(curMb = 0, "", FormatCur(Abs(curMb)))
'             cItemClass(nFixRows + j) = IIf(IsNull(!Field7), "", !Field7)
'             j = j + 1
'             With pzZhye
'                .cSign(i) = rsDisplay!Fieldx
'                .iBook(i) = rsDisplay!fColor
'                .iNo_id(i) = rsDisplay!Field0
'                .iPeriod(i) = rsDisplay!Fieldy
'             End With
'          End If
'          .MoveNext