?? clsvchdefbi.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 = "clsVchDefBI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'--------------------------------
'時間:2001.11.12
'版權:北京用友軟件股份有限公司
'設計:章景峰
'編碼:章景峰
'說明:U8資金管理---業務對象
'--------------------------------
Option Explicit
Public Function Init(ByVal DataSourceName As String, ByVal BIStyle As Long) As U8FDEso.EntityObject
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 Init = objEO
Set objOID = Nothing
Set objEO = Nothing
Set objDataMgr = Nothing
Set objOIDMgr = Nothing
End Function
Public Function MoveTo(ByVal DataSourceName As String, MoveMode As U8FDEso.MoveModeEnum, ByVal BIStyle As Long, Optional OID As U8FDEso.OIDObject) As U8FDEso.EntityObject
Dim objEO As U8FDEso.EntityObject
Dim objDataMgr As New U8FDmgr.DataManager
Set objEO = objDataMgr.LoadEOMetaData(DataSourceName, BIStyle)
If Not OID Is Nothing Then Set objEO.OID = OID
If con.State = adStateClosed Then con.Open DataSourceName
If objDataMgr.MoveTo(con, objEO, MoveMode, True) Then
Set MoveTo = objEO
Else
Set MoveTo = Nothing
End If
Set objEO = Nothing
Set objDataMgr = Nothing
End Function
Public Function FindByCode(DataSourceName As String, BIStyle As Long, Code As String) 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 substring(" & objEO.SourceOIDField & ",1,2)=" & BIStyle & " and " & objEO("transactions_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, U8FDEso.esoCurrent
Set FindByCode = objEO
Set objOID = Nothing
Set objDataMgr = Nothing
Set objEO = Nothing
End Function
Public Function Save(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, ByVal BIStyle As Long) As Boolean
Dim objDataMgr As New U8FDmgr.DataManager
Dim objOIDMgr As New U8FDmgr.OIDManager
Dim objOID As U8FDEso.OIDObject
If Not Validate(DataSourceName, EO, BIStyle) Then Exit Function
If EO.State = esoAddNew Then
Set objOID = objOIDMgr.GetNewOID(DataSourceName, BIStyle, True)
Set EO.OID = objOID
End If
If con.State = adStateClosed Then con.Open DataSourceName
Dim sql As String
Dim rec As New ADODB.Recordset
sql = "select count(*) from " & EO.SourceTable & " where substring(" & EO.SourceOIDField & ",1,2)='" & Mid(EO(EO.SourceOIDField).Value, 1, 2) & "' and " & EO.SourceOIDField & " <> '" & EO(EO.SourceOIDField).Value & "' and " & EO("transactions_code").SourceField & "='" & EO("transactions_code").Value & "'"
rec.Open sql, con, adOpenDynamic, adLockOptimistic
If rec.Fields(0).Value > 0 Then
rec.Close
Set rec = Nothing
Exit Function
End If
rec.Close
Set rec = Nothing
If EO.BiType = 32 Or EO.DeriveBIType = 32 Or EO.BiType = 34 Or EO.DeriveBIType = 34 Then
'先刪除生成的利息單,再生成新的利息單
If Not CreateAccrual(DataSourceName, EO) Then
Exit Function
End If
End If
Save = objDataMgr.Save(con, EO)
Set objOIDMgr = Nothing
Set objDataMgr = Nothing
Set objOID = Nothing
End Function
Public Function CreateAccrual(DataSourceName As String, EO As U8FDEso.EntityObject) As Boolean
Dim objEO As New U8FDEso.EntityObject
Dim objDataMgr As New U8FDmgr.DataManager
Dim objOIDMgr As New U8FDmgr.OIDManager
Dim rec As New ADODB.Recordset
Dim rec2 As New ADODB.Recordset
Dim sql As String
If con.State = adStateClosed Then con.Open DataSourceName
If EO.BiType = 32 Or EO.DeriveBIType = 32 Then
Set objEO = Init(DataSourceName, 51)
sql = "select " & objEO.SourceOIDField & " from " & objEO.SourceTable & " where substring(" & objEO.SourceOIDField & ",1,2)=51 and " & objEO("rcv_acc_id").SourceField & "='" & EO("fixed_acc_id") & "'"
rec.Open sql, con, adOpenDynamic, adLockOptimistic
If Not rec.EOF Then
objEO(objEO.SourceOIDField) = rec.Fields(0)
If Not Delete(DataSourceName, objEO, objEO.BiType) Then
Exit Function
End If
End If
Set rec = Nothing
objEO.State = U8FDEso.esoAddNew
objEO("transactions_id") = objOIDMgr.GetNewOID(DataSourceName, objEO.BiType, True).ID
objEO("transactions_code") = GetMaxCode(DataSourceName, objEO, objEO.BiType)
objEO("bill_date") = EO("bill_date")
objEO("rcv_acc_id") = EO("fixed_acc_id")
If Not GetFixInfo(DataSourceName, EO, EO("fixed_acc_id")) Is Nothing Then
Set rec2 = GetFixInfo(DataSourceName, EO, EO("fixed_acc_id"))
rec2.MoveFirst
objEO("sum_mny") = EO("sum_mny") - rec2(EO.Fields.Item("sum_mny").Name) 'EO("sum_mny")為本息合計,此處應為利息值.EO("sum_mny")-本金
Set rec2 = Nothing
Else
objEO("sum_mny") = EO("sum_mny") 'EO("sum_mny")為本息合計,此處應為利息值.EO("sum_mny")-本金
End If
objEO("mh_mny") = EO("sum_mny")
objEO("exchange_rate") = EO("exchange_rate")
objEO("natural_mny") = EO("natural_mny")
objEO("from_date") = EO("bill_date")
objEO("to_date") = EO("bill_date")
objEO("irate_id") = EO("irate_id")
objEO("digest") = "應計利息"
objEO("bill_name") = EO("bill_name")
objEO("vouchertype_flag") = 1
ElseIf EO.BiType = 34 Or EO.DeriveBIType = 34 Then
Set objEO = Init(DataSourceName, 54)
sql = "select " & objEO.SourceOIDField & " from " & objEO.SourceTable & " where substring(" & objEO.SourceOIDField & ",1,2)=54 and " & objEO("rcv_acc_id").SourceField & "='" & EO("fixed_acc_id") & "'"
rec.Open sql, con, adOpenDynamic, adLockOptimistic
If Not rec.EOF Then
objEO(objEO.SourceOIDField) = rec.Fields(0)
If Not Delete(DataSourceName, objEO, objEO.BiType) Then
Exit Function
End If
End If
Set rec = Nothing
objEO.State = U8FDEso.esoAddNew
objEO("transactions_id") = objOIDMgr.GetNewOID(DataSourceName, objEO.BiType, True).ID
objEO("transactions_code") = GetMaxCode(DataSourceName, objEO, objEO.BiType)
objEO("bill_date") = EO("bill_date")
objEO("rcv_acc_id") = EO("fixed_acc_id")
If Not GetFixInfo(DataSourceName, EO, EO("fixed_acc_id")) Is Nothing Then
Set rec2 = GetFixInfo(DataSourceName, EO, EO("fixed_acc_id"))
rec2.MoveFirst
objEO("sum_mny") = EO("sum_mny") - rec2(EO.Fields.Item("sum_mny").Name) 'EO("sum_mny")為本息合計,此處應為利息值.EO("sum_mny")-本金
Set rec2 = Nothing
Else
objEO("sum_mny") = EO("sum_mny") 'EO("sum_mny")為本息合計,此處應為利息值.EO("sum_mny")-本金
End If
objEO("mh_mny") = EO("sum_mny") '+計算利息
objEO("exchange_rate") = EO("exchange_rate")
objEO("natural_mny") = EO("natural_mny")
objEO("from_date") = EO("bill_date")
objEO("to_date") = EO("bill_date")
objEO("irate_id") = EO("irate_id")
objEO("digest") = "應計利息"
objEO("bill_name") = EO("bill_name")
objEO("vouchertype_flag") = 1
End If
If objDataMgr.Save(con, objEO) Then
CreateAccrual = True
Else
CreateAccrual = False
End If
Set objOIDMgr = Nothing
Set objEO = Nothing
Set objDataMgr = Nothing
End Function
Public Function Delete(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, ByVal BIStyle As Long, Optional MsgXml As String) As Boolean
Dim objDataMgr As New U8FDmgr.DataManager
Dim rec As New ADODB.Recordset
Dim sql As String
MsgXml = ""
If con.State = adStateClosed Then con.Open DataSourceName
If EO.BiType = 31 Or EO.DeriveBIType = 31 Or EO.BiType = 33 Or EO.DeriveBIType = 33 Then
sql = "select * from fd_transactions,fd_entities where substring(fd_transactions.transactions_id,1,2)=fd_entities.iBIType" & " and (iBIType=32 or iDeriveBIType=32 or iBIType=34 or iDeriveBIType=34) and fixed_acc_id='" & EO("fixed_acc_id") & "'"
rec.Open sql, con, adOpenDynamic, adLockReadOnly
If Not rec.EOF Then
MsgXml = "這筆存款已經生成取款單,不能刪除!"
Delete = False
rec.Close
Exit Function
End If
rec.Close
End If
If EO.BiType = 41 Or EO.DeriveBIType = 41 Or EO.BiType = 43 Or EO.DeriveBIType = 43 Or EO.BiType = 45 Or EO.DeriveBIType = 45 Then
sql = "select * from fd_transactions where correspond_vch_id='" & EO("transactions_id") & "'"
rec.Open sql, con, adOpenDynamic, adLockReadOnly
If Not rec.EOF Then
MsgXml = "這筆業務已經生成還款單,不能刪除!"
Delete = False
rec.Close
Exit Function
End If
rec.Close
End If
sql = "select cBus_id From FD_Vouch where cBus_id = '" & EO.BiType & EO("transactions_code") & " '"
rec.Open sql, con, adOpenDynamic, adLockReadOnly
If Not rec.EOF Then
MsgXml = "這筆業務已經生成憑證,不能刪除!"
Delete = False
rec.Close
Exit Function
End If
rec.Close
Delete = objDataMgr.Delete(con, EO)
Set objDataMgr = Nothing
End Function
Public Function DeleteBIType(ByVal DataSourceName As String, ByVal BIStyle As Long) As Boolean
Dim objDataMgr As New U8FDmgr.DataManager
Dim cmdDeleteFields As ADODB.Command
Dim prmDeleteFields As ADODB.Parameter
If con.State = adStateClosed Then con.Open DataSourceName
DeleteBIType = objDataMgr.DeleteBIType(con, BIStyle)
Set cmdDeleteFields = New ADODB.Command
Set cmdDeleteFields.ActiveConnection = con
cmdDeleteFields.CommandText = "FD_DeleteFields"
cmdDeleteFields.CommandType = adCmdStoredProc
cmdDeleteFields.CommandTimeout = 15
Set prmDeleteFields = New ADODB.Parameter
Set prmDeleteFields = cmdDeleteFields.CreateParameter("BIStyle", adInteger, adParamInput, 1, BIStyle)
cmdDeleteFields.Parameters.Append prmDeleteFields
cmdDeleteFields.Execute
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -