clssubject.cls

一个用VB写的财务软件源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsSubject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'2001.12.27 卞荣兵修改
Option Explicit
Option Base 1

Private m_bExist As Boolean
Private m_sCode As String
Private m_sName As String
Private m_sNamePath As String
Dim m_aryKmCodeLen() As Integer         '科目编码长度数组

Public Property Get SubjectIsExist() As Boolean
    SubjectIsExist = m_bExist
End Property
Public Property Get SubjectCode() As String
    SubjectCode = m_sCode
End Property
Public Property Get SubjectName() As String
    SubjectName = m_sName
End Property
Public Property Get SubjectNamePath() As String
    SubjectNamePath = m_sNamePath
End Property

'2001.12.27 卞荣兵修改
Private Sub Class_Initialize()
    Dim rstKmCodeLevel As ADODB.Recordset
    Dim i As Long
    
    m_bExist = False
    '判断是否是定长的科目编码,是,则设置科目代码各级的长度的数组
    If glo.sSeparateSubject = "0" Then
        '形成科目编码方案数组;
        Set rstKmCodeLevel = New ADODB.Recordset
        With rstKmCodeLevel
            .CursorLocation = adUseClient
            .Open "select * from tUSU_dmjs where Type='科目' order by JC", _
                        glo.cnnMain, adOpenStatic, adLockReadOnly
            ReDim m_aryKmCodeLen(.RecordCount)
            i = 1
            .MoveFirst
            Do Until .EOF
                If i = 1 Then
                    m_aryKmCodeLen(i) = .Fields("ws").Value
                Else
                    m_aryKmCodeLen(i) = m_aryKmCodeLen(i - 1) + .Fields("ws").Value
                End If
                i = i + 1
                .MoveNext
            Loop
            .Close
        End With
   End If
End Sub

Public Sub Init(ByVal sInput As String, ByVal sYear As String)
    Dim rstTemp As ADODB.Recordset
    Dim i As Long, iLevel As Integer
    Dim sCodePre As String
    Dim iCount As Integer
    Dim sGet As String
    
    Set rstTemp = New ADODB.Recordset
    m_sNamePath = ""
    With rstTemp
        .CursorLocation = adUseClient
        '查找科目代码或名称或助记码是否存在
        .Open "select kmdm,kmmc,zjm from tZW_km" & sYear & _
            " where rtrim(kmdm)='" & sInput & "' or rtrim(kmmc)='" & _
            sInput & "' or rtrim(zjm)='" & sInput & "'", _
                    glo.cnnMain, adOpenStatic, adLockReadOnly
        If .RecordCount = 0 Then
            m_bExist = False
        Else
            m_bExist = True
            m_sCode = Trim$("" & .Fields("kmdm").Value)
            m_sName = Trim$("" & .Fields("kmmc").Value)
            
            '取当前科目的前一级科目代码
            If glo.sSeparateSubject = "0" Then
                    '求当前科目级次
                     For i = LBound(m_aryKmCodeLen) To UBound(m_aryKmCodeLen)
                         If m_aryKmCodeLen(i) >= Len(m_sCode) Then
                             iLevel = i
                             Exit For
                         End If
                     Next i
                    '求从一级科目到当前科目的名称路径
                    m_sNamePath = ""
                    If iLevel > 1 Then
                        For i = 1 To iLevel - 1
                            sCodePre = Left(m_sCode, m_aryKmCodeLen(i))
                            m_sNamePath = m_sNamePath & GetSubjectName(sCodePre, sYear) & "\"
                        Next i
                    End If

             Else
                    '统计当前科目的级次
                     iCount = 0
                     iLevel = CountSeperateChar(m_sCode)
                     If iLevel <> 0 Then
                        For i = 1 To Len(m_sCode)
                          sGet = Mid(m_sCode, i, 1)
                          If sGet = glo.sSeparateSubject Then
                             iCount = iCount + 1
                             sCodePre = Left(m_sCode, i - 1)
                              m_sNamePath = m_sNamePath & GetSubjectName(sCodePre, sYear) & "\"
                          End If
                          If iCount = iLevel Then
                              Exit For
                          End If
                        Next i
                        m_sNamePath = m_sNamePath & m_sName
                      Else
                         sCodePre = m_sCode
                         m_sNamePath = m_sNamePath & GetSubjectName(sCodePre, sYear)
                      End If
             End If
            If glo.sSeparateSubject = "0" Then
              m_sNamePath = m_sNamePath & m_sName
            End If
        End If
        .Close
    End With

End Sub

Private Function GetSubjectName(ByVal sCode As String, ByVal sYear As String) As String
    Dim rstTemp As ADODB.Recordset
    
    Set rstTemp = New ADODB.Recordset
    With rstTemp
        .CursorLocation = adUseClient
        .Open "select kmmc from tZW_km" & sYear & _
                " where rtrim(kmdm)='" & sCode & "'", _
            glo.cnnMain, adOpenStatic, adLockReadOnly
        GetSubjectName = Trim$("" & .Fields(0).Value)
        .Close
    End With
    
End Function