cbill_show.cls

BOS大赛培训认证+-+样例代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 2  'RequiresTransaction
END
Attribute VB_Name = "CBill_Show"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "This is MiddleWareEvents Interface Class [ AfterMultiCheck ], made by K3BOSPLUGINSWIZAED"
'名称: AfterMultiCheck
'描述: 多级审核的逻辑，如果当前级别是业务审核，则调用审核接口
'版本: V10.4
'作者: Christin
'//参数
'/*@ sDsn K/3连接字符串
'/*@ nClassID Long, 业务对象事务类型
'/*@ nFBillID Long, 业务单据内码
'/*@ nFPage Long, 业务单据页码
'/*@ nFBillEntryID, 业务单据分录内码
'/*@ dctBillCheckRecord, 审核路线数据包
'返回值:
'创建时间: 2007-04-04

Public Function AfterMultiCheck(ByVal Sdsn As String, _
        ByVal nClassID As Long, _
        ByVal nFBillID As Long, _
        Optional ByVal nFPage As Long = 1, _
        Optional ByVal nFBillEntryID As Long = 0, _
        Optional ByVal dctBillCheckRecord As KFO.Dictionary) As Boolean
        GetObjectContext.SetAbort
        
        On Error GoTo HError
        Dim bCancel As Boolean
        Dim rs As ADODB.Recordset
        Dim ConnectString As String
        Dim m_cnn As ADODB.Connection
        
        If dctBillCheckRecord Is Nothing Then
            Err.Raise 5, "BOSV104MShow.CBill_Show.AfterMultiCheck", "缺少参数: dctBillCheckRecord "
        End If
        If Not dctBillCheckRecord.Lookup("FMode") Then
            Err.Raise 5, "BOSV104MShow.CBill_Show.AfterMultiCheck", " 缺少参数:FMode "
        End If
        If Not dctBillCheckRecord.Lookup("OverBusinessLevel") Then
            Err.Raise 5, "BOSV104MShow.CBill_Show.AfterMultiCheck", " 缺少参数:OverBusinessCheck "
        End If
        
        '判断当前操作为审核或反审核
        bCancel = IIf(dctBillCheckRecord("FMode") = 2, True, False) '0审核,2反审核
        '判断当前审核级次是否为业务审核
        If Not dctBillCheckRecord("OverBusinessLevel") Then '业务审核
            GoTo HExit
        End If
        
        '由于sDsn不是标准ADO连接串,需从中截取出标准连接串
        ConnectString = Left(Sdsn, InStr(1, Sdsn, "}") - 1)
        ConnectString = Mid(ConnectString, 16)
        
        Set m_cnn = New ADODB.Connection
        m_cnn.Open ConnectString
        m_cnn.CursorLocation = adUseClient
        m_cnn.CommandTimeout = 0
    
        bCancel = IIf(dctBillCheckRecord("FMode") = 2, True, False) '0审核,2反审核
        If bCancel Then
            Set rs = m_cnn.Execute("select 1 from t_BOS200000001 where fvoucherid_id>0 and FID=" & CStr(nFBillID))
            If rs.RecordCount > 0 Then
                Err.Raise 5, "BOSV104MShow.CBill_Show.AfterMultiCheck", "单据已经做帐，不允许反审核！"
                
                GoTo HExit
            End If
            Set rs = m_cnn.Execute("select 1 from t_BOS200000001entry2 where FFinishQty>0 and FID=" & CStr(nFBillID))
            If rs.RecordCount > 0 Then
                Err.Raise 5, "BOSV104MShow.CBill_Show.AfterMultiCheck", "单据被其他单据关联，不允许反审核！"
                GoTo HExit
            End If
            m_cnn.Execute ("Update t_BOS200000001 set FStatus=0 where FID=" & CStr(nFBillID))
        Else
            m_cnn.Execute ("Update t_BOS200000001 set FStatus=1 where FID=" & CStr(nFBillID))
        End If
HExit:
        GetObjectContext.SetComplete
        AfterMultiCheck = True
        If Not m_cnn Is Nothing Then m_cnn.Close
        Set m_cnn = Nothing
        Set rs = Nothing
        Exit Function
HError:
        GetObjectContext.SetAbort
        AfterMultiCheck = False
        Err.Raise 5, "BOSV104MShow.CBill_Show.AfterMultiCheck", Err.Description
        If Not m_cnn Is Nothing Then m_cnn.Close
        Set m_cnn = Nothing
        Set rs = Nothing
End Function