caccsum.cls

用友u8财务源码,用visual basic开发

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CAccSum"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit 

Private m_sAccID  As String
Private m_dBill   As Date
Private m_cMb     As Currency
Private m_cMh     As Currency
Private m_cMcde   As Currency
Private m_cMcdeh  As Currency

Private m_cMh_Cad       As Currency
Private m_cMcdeh_Cad    As Currency

Private m_cTuningMh     As Currency
Private m_cTuningMh_cde As Currency

Private m_DB   As UfDatabase
Private m_Rs   As New UfRecordset

Public Event IsMatched(bMatched As Boolean)

Public Sub Init(oDB As UfDatabase, Optional oRs As UfRecordset)
   Set m_DB = oDB
End Sub

Public Function Retrieve(sAccID As String, dBill As Date) As Long
   Dim SQL As String
   
   m_sAccID = sAccID
   m_dBill = dBill
   
'--------------------------------------- cuidong 2001.03.19
'   Dim oAcc As UfZJSet.CAccount
'   '----判断账户是否存在,开户日期
'   Set oAcc = New UfZJSet.CAccount
'   oAcc.Init m_DB, , sAccID
'   '----Account isn't exist.
'   If oAcc.oError.ErrNumber <> 0 Then Exit Function
'   '----dBill is before Account's opendate, this is not allowed
'   If oAcc.OpenDate > dBill Then Exit Function
'---------------------------------------
'
'--------------------------------------- cuidong 2001.03.19
   SQL = "Select * From FD_AccDef Where cAccID = '" & m_sAccID & "'"
   Set m_Rs = m_DB.OpenRecordset(SQL, dbOpenSnapshot)
   If m_Rs.EOF Then
      Retrieve = -1
      RaiseEvent IsMatched(False)
      Exit Function
   Else
      If m_Rs.Fields!dOpenDate > dBill Then
         Retrieve = -1
         RaiseEvent IsMatched(False)
         Exit Function
      End If
   End If
   m_Rs.oClose
'---------------------------------------

   Dim sqlAccSum  As String
   
   
   sqlAccSum = "Select * From FD_AccSum Where cAccID = '" & _
      m_sAccID & "' And dbill_date = '" & FormatDate(m_dBill) & "'"
   Set m_Rs = m_DB.OpenRecordset(sqlAccSum, dbOpenSnapshot)
   If m_Rs.EOF Then
      Retrieve = -1
      RaiseEvent IsMatched(False)
      Exit Function
   End If
   
   With m_Rs
      m_sAccID = !cAccID
      m_dBill = !dbill_date
      m_cMb = !Mb
      m_cMh = !Mh
      m_cMcde = !Mcde
      m_cMcdeh = !Mcdeh
      m_cMh_Cad = !Mh_Cad
      m_cMcdeh_Cad = !Mcdeh_Cad
      m_cTuningMh = !mb_Cad
      m_cTuningMh_cde = !mcde_Cad
   End With
   
   RaiseEvent IsMatched(True)
      
   m_Rs.oClose
   Set m_Rs = Nothing
End Function

Public Function TuneJs(cTuningJs As Currency, cTuningJs_cde As Currency) As Long
   Dim sqlExec As String
   
   m_cTuningMh = cTuningJs
   m_cTuningMh_cde = cTuningJs_cde
   
   On Error GoTo lblOut
   
   m_DB.BeginTrans
   
   sqlExec = "Update FD_AccSum Set mh = mh + " & (cTuningJs + cTuningJs_cde) & _
      ", mcdeh = mcdeh + " & cTuningJs_cde & " Where cAccID = '" & _
      m_sAccID & "' And dbill_date >= '" & FormatDate(m_dBill) & "'"
   m_DB.Execute sqlExec, dbFailOnError
   
   '--- 利用 FD_AccSum 中的 mb_Cad 和 mcde_Cad 两个备用字段存储调整的积数
   sqlExec = "Update FD_AccSum Set mb_Cad = mb_Cad + " & (cTuningJs + cTuningJs_cde) & _
      ", mcde_Cad = mcde_Cad + " & cTuningJs_cde & " Where cAccID = '" & _
      m_sAccID & "' And dbill_date = '" & FormatDate(m_dBill) & "'"
   m_DB.Execute sqlExec, dbFailOnError
   
   m_DB.CommitTrans
   
   Exit Function
   
lblOut:
   m_DB.Rollback
   TuneJs = -1
End Function

Public Sub Save()

End Sub

Public Property Get AccID() As String
   AccID = m_sAccID
End Property

Public Property Let AccID(ByVal vNewValue As String)
   m_sAccID = vNewValue
End Property

Public Property Get BillDate() As Date
   BillDate = m_dBill
End Property

Public Property Let BillDate(ByVal vNewValue As Date)
   m_dBill = vNewValue
End Property

Public Property Get Mb() As Currency
   Mb = m_cMb
End Property

Public Property Let Mb(ByVal vNewValue As Currency)
   m_cMb = vNewValue
End Property

Public Property Get Mh() As Currency
   Mh = m_cMh
End Property

Public Property Let Mh(ByVal vNewValue As Currency)
   m_cMh = vNewValue
End Property

Public Property Get Mcde() As Currency
   Mcde = m_cMcde
End Property

Public Property Let Mcde(ByVal vNewValue As Currency)
   m_cMcde = vNewValue
End Property

Public Property Get Mcdeh() As Currency
   Mcdeh = m_cMcdeh
End Property

Public Property Let Mcdeh(ByVal vNewValue As Currency)
   m_cMcdeh = vNewValue
End Property

Public Property Get Mh_Cad() As Currency
   Mh_Cad = m_cMh_Cad
End Property

Public Property Let Mh_Cad(ByVal vNewValue As Currency)
   m_cMh_Cad = vNewValue
End Property

Public Property Get Mcdeh_Cad() As Currency
   Mcdeh_Cad = m_cMcdeh_Cad
End Property

Public Property Let Mcdeh_Cad(ByVal vNewValue As Currency)
   m_cMcdeh_Cad = vNewValue
End Property

Public Property Get TuningMh() As Currency
   TuningMh = m_cTuningMh
End Property

Public Property Let TuningMh(ByVal vNewValue As Currency)
   m_cTuningMh = vNewValue
End Property

Public Property Get TuningMh_cde() As Currency
   TuningMh_cde = m_cTuningMh_cde
End Property

Public Property Let TuningMh_cde(ByVal vNewValue As Currency)
   m_cTuningMh_cde = vNewValue
End Property