?? clsiratebi.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 = "clsIRateBI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'--------------------------------
'時間:2001.11.12
'版權:北京用友軟件股份有限公司
'設計:章景峰
'編碼:章景峰
'說明:U8資金管理---業務對象
'--------------------------------
Option Explicit
Private Const m_conBIStyle As Long = 8
''得到利率(指定日期、金額,主要用于得出定額利率)
'Public Function GetIRate(sDataSourceName As String, sOID As String, dDate As Date, cMoney As Currency) As Double
'
'End Function
Public Function Init(ByVal DataSourceName As String, Optional ByVal BIStyle As Long = m_conBIStyle) As U8FDEso.EntityObject
Dim objEO As U8FDEso.EntityObject
Dim objDataMgr As New U8FDmgr.DataManager
Dim objOIDMgr As New U8FDmgr.OIDManager
Set objEO = objDataMgr.LoadEOMetaData(DataSourceName, BIStyle)
Set objEO.OID = objOIDMgr.GetNewOID(DataSourceName, BIStyle, True)
Set Init = objEO
Set objDataMgr = Nothing
Set objOIDMgr = Nothing
Set objEO = Nothing
End Function
Public Function MoveTo(ByVal DataSourceName As String, MoveMode As U8FDEso.MoveModeEnum, Optional ByVal BIStyle As Long = m_conBIStyle, 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 objDataMgr = Nothing
Set objEO = Nothing
End Function
Public Function Save(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, Optional ByVal BIStyle As Long = m_conBIStyle) As Boolean
Dim objDataMgr As New U8FDmgr.DataManager
Dim objOIDMgr As New U8FDmgr.OIDManager
Dim objOID As U8FDEso.OIDObject
If Not Validate(DataSourceName, EO) Then Exit Function
'這一步應該注釋掉,eo.oid已經賦值,使用這一步會使OID再次加1。
If EO.State = esoAddNew Then
Set objOID = objOIDMgr.GetNewOID(DataSourceName, BIStyle)
Set EO.OID = objOID
End If
If con.State = adStateClosed Then con.Open DataSourceName
Save = objDataMgr.Save(con, EO)
Set objOID = Nothing
Set objOIDMgr = Nothing
Set objDataMgr = Nothing
End Function
Public Function Delete(ByVal DataSourceName As String, EO As U8FDEso.EntityObject, Optional ByVal BIStyle As Long = m_conBIStyle) As Boolean
Dim objDataMgr As New U8FDmgr.DataManager
If con.State = adStateClosed Then con.Open DataSourceName
Delete = objDataMgr.Delete(con, EO)
Set objDataMgr = Nothing
End Function
Public Function Validate(ByVal DataSourceName As String, EO As U8FDEso.EntityObject) As Boolean
Select Case EO.State
Case esoAddNew
Case esoDelete
Case esoEdit
Case esoInitialized
Case esoInstance
End Select
Dim oFO As FieldObject
Dim i As Integer
If EO.EOS.Count > 0 Then
With EO.EOS(EO.EOS.Count)
For i = 1 To .Fields.Count
Set oFO = .Fields.Item(i)
If Not oFO.Name = EO.EOS.EOMetaData.ParentField And Not oFO.Name = EO.EOS.EOMetaData.SourceOIDField Then
'----已使用并可持久化
If oFO.IsUsed And oFO.Persistent Then
'----設置值為默認值
If IsEmpty(oFO.Value) Or IsNull(oFO.Value) Then
oFO.Value = oFO.DefaultValue
End If
'----檢查不允許為空的域對象是否為空
If Not oFO.AllowNull Then
If IsNull(oFO.Value) Then
Err.Raise vbObjectError + 3000, oFO.Name, oFO.Caption & "不能為空!"
End If
End If
End If
End If
Next
End With
End If
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 = esoInitialized
.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)
End With
objEOs.Append objEO, "K" & rec!iBIType
rec.MoveNext
Loop
rec.Close
Set rec = Nothing
Set LoadVchEOs = objEOs
Set objEO = Nothing
Set objEOs = Nothing
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
SaveVchEOs = True
Set objDataMgr = Nothing
End Function
Public Function RecordCount(ByVal DataSourceName As String, EO As U8FDEso.EntityObject)
Dim sql As String
Dim rec As New ADODB.Recordset
If con.State = adStateClosed Then con.Open DataSourceName
sql = "Select count(*) From " & EO.SourceTable
rec.Open sql, con, adOpenStatic, adLockOptimistic
RecordCount = rec.Fields(0).Value
rec.Close
Set rec = Nothing
End Function
Public Function IrateIsExist(DataSourceName As String, ID As String) As Boolean
Dim rec As New ADODB.Recordset
IrateIsExist = False
If con.State = adStateClosed Then con.Open DataSourceName
rec.Open "Select irate_id From FD_Intra Where irate_id = '" & ID & "'", con
If Not rec.EOF Then
IrateIsExist = True
End If
rec.Close
Set rec = Nothing
End Function
Public Function FindByCode(DataSourceName As String, Code As String, Optional ByVal BIStyle As Long = m_conBIStyle) 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 " & objEO("irate_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, esoCurrent
Set FindByCode = objEO
Set objOID = Nothing
Set objDataMgr = Nothing
Set objEO = Nothing
End Function
Public Function IsUsed(DataSourceName As String, ID As String) As Boolean
Dim rec As New ADODB.Recordset
Dim sql As String
sql = "select 1 from fd_accdef where irate_id = '" & ID & "'"
sql = sql & " union select 1 from fd_transactions where irate_id = '" & ID & "'"
If con.State = adStateClosed Then con.Open DataSourceName
rec.Open sql, con
If Not rec.EOF Then
IsUsed = True
Else
IsUsed = False
End If
rec.Close
Set rec = Nothing
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -