mdlsubroutine.bas

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

Attribute VB_Name = "mdlSubroutine"
Option Explicit
Option Base 1
Public sTitleName As String
Public m_mFg As Object
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

''''''''''''''''''''''''
'取得结算方式的名称
'@Param Code:结算方式的代码
'@Return : 名称
Public Function GetJsfsName(ByVal Code As String) As String
Dim rSt As New Recordset
rSt.Open "Select cName from tZW_Jsfs" + glo.sOperateYear + " where cCode='" + Trim$(Code) + "'", glo.cnnMain, adOpenKeyset, adLockOptimistic
If Not rSt.EOF Then
    If IsNull(rSt.Fields(0).value) = False Then GetJsfsName = rSt.Fields(0).value
End If
rSt.Close
Set rSt = Nothing
End Function

'取得一个账套的使用单位名称
'   AccountID:  账套号
Public Function GetEnterName(ByVal AccountID As String) As String
    Dim rSt As ADODB.Recordset
    
    Set rSt = New ADODB.Recordset
    With rSt
        .CursorLocation = adUseClient
        .Open "select EnterName from tSYS_Account where AccountID='" & _
            glo.sAccountID & "'", gloSys.cnnSYS, adOpenStatic, adLockReadOnly
        GetEnterName = .Fields("EnterName").value
        .Close
    End With
    
End Function

'取得一个日期所在的会计期
'   sDate:  日期
Public Function GetPeriod(ByVal sdate As String) As Integer
    Dim rSt As ADODB.Recordset
    
    Set rSt = New ADODB.Recordset
   
    With rSt
        .CursorLocation = adUseClient
        Select Case g_FLAT
            Case "SQL"
                .Open "select * from tSYS_Period where AccountID='" & glo.sAccountID & _
                    "' and fromdate<='" & Format(sdate, "yyyy-mm-dd") & "' and todate>='" & Format(sdate, "yyyy-mm-dd") & "'", _
                    gloSys.cnnSYS, adOpenStatic, adLockReadOnly
            Case "ORACLE"
                .Open "select * from tSYS_Period where AccountID='" & glo.sAccountID & _
                    "' and fromdate<=TO_DATE('" & Format(sdate, "yyyy-mm-dd") & "','YYYY-MM-DD') and todate>=TO_DATE('" & Format(sdate, "yyyy-mm-dd") & "','YYYY-MM-DD')", _
                    gloSys.cnnSYS, adOpenStatic, adLockReadOnly
        End Select
        If (.EOF And .BOF) Then
            GetPeriod = 0
            Exit Function
        Else
            GetPeriod = .Fields("periodID").value
        End If
        .Close
    End With
    
End Function

'取一个会计期的起始日期
'
Public Function GetPeriodFrom(ByVal iPeriod As Integer) As String
    Dim rSt As ADODB.Recordset
    
    Set rSt = New ADODB.Recordset
    With rSt
        .CursorLocation = adUseClient
        .Open "select * from tSYS_Period where AccountID='" & glo.sAccountID & _
            "' and Year='" & glo.sOperateYear & "' and periodID=" & CStr(iPeriod), _
            gloSys.cnnSYS, adOpenStatic, adLockReadOnly
        If .RecordCount = 0 Then
            Err.Raise 5
        Else
            GetPeriodFrom = Format(.Fields("fromdate").value, "yyyy-mm-dd")
        End If
        .Close
    End With

End Function

'取一个会计期的截止日期
'
Public Function GetPeriodTo(ByVal iPeriod As Integer) As String
    Dim rSt As ADODB.Recordset
    
    Set rSt = New ADODB.Recordset
    With rSt
        .CursorLocation = adUseClient
        .Open "select * from tSYS_Period where AccountID='" & glo.sAccountID & _
            "' and Year='" & glo.sOperateYear & "' and periodID=" & CStr(iPeriod), _
            gloSys.cnnSYS, adOpenStatic, adLockReadOnly
        If .RecordCount = 0 Then
            Err.Raise 5
        Else
            GetPeriodTo = Format(.Fields("ToDate").value, "yyyy-mm-dd")
        End If
        .Close
    End With

End Function


'取得一个用户的代码
Public Function GetUserID(ByVal UserName As String)
    Dim rSt As ADODB.Recordset
    
    Set rSt = New ADODB.Recordset
    With rSt
        .CursorLocation = adUseClient
        .Open "select * from tSYS_User where UserName='" & Trim$("" & UserName) & "'", _
                gloSys.cnnSYS, adOpenStatic, adLockReadOnly
        If .RecordCount = 0 Then
            MsgBox "无该用户！", vbInformation
            GetUserID = ""
            Err.Raise 5
        Else
            GetUserID = Trim$("" & .Fields("UserID").value)
        End If
        .Close
    End With
    
End Function



'取出结账日期
Public Function Get_LockDate() As String
    Dim rSt As ADODB.Recordset
    Dim sSQL As String
    Dim sYear As String
    Dim sMonth As String
    
    Set rSt = New ADODB.Recordset
    rSt.CursorLocation = adUseClient
    sSQL = "SELECT ModiYear, ModiMonth FROM tSYS_SubSysUsed" & _
            " WHERE AccountID = '" & glo.sAccountID & _
            "' AND SubSysID = '" & gloSys.sSubSysId & "'"
    rSt.Open sSQL, gloSys.cnnSYS, adOpenStatic, adLockReadOnly
    With rSt
        If .RecordCount <> 0 Then
            sYear = .Fields("ModiYear").value
            sMonth = .Fields("ModiMonth").value
        End If
    End With
    If sMonth = "12" Then
        Get_LockDate = sYear & "-" & sMonth & "-31"
    Else
        Get_LockDate = sYear & "-" & sMonth & "-" & _
                    DateDiff("d", sYear & "-" & sMonth & "-01", sYear & "-" & _
                    Format(Val(sMonth) + 1, "00") & "-01")
    End If
End Function



'判断当前账页的列宽是否被改变;
Public Function IsColChange(ByVal cllr As CELL50Lib.Cell, ByRef iColWidth As Variant) As Boolean
    Dim curColWidth As Variant
    Dim i As Integer
    
    For i = LBound(iColWidth) To UBound(iColWidth)
      curColWidth = cllr.GetColWidth(1, i, 0) '01.18 肖兆芹修改
        If curColWidth <> "" Then
            If curColWidth <> iColWidth(i) Then
                IsColChange = True
                iColWidth(i) = curColWidth
            End If
        End If
    Next i
End Function

'保存账页的列宽
Public Sub SaveColChange(ByVal iColWidth As Variant, ByVal sAccountType As String, _
                        ByVal sAccountFormat As String)
    Dim adoCmd As ADODB.Command
    Dim sColWidth As String
    Dim i As Integer
    
    For i = LBound(iColWidth) To UBound(iColWidth)
        If i = LBound(iColWidth) Then
            sColWidth = iColWidth(i)
        Else
            sColWidth = sColWidth & "," & iColWidth(i)
        End If
    Next i
    
    Set adoCmd = New ADODB.Command
    adoCmd.CommandType = adCmdText
    adoCmd.ActiveConnection = glo.cnnMain
    adoCmd.CommandText = "UPDATE tUSU_AccountFormat SET ColWidth = '" & sColWidth & _
                            "' WHERE AccountType = '" & sAccountType & "'" & _
                            " AND AccountFormat = '" & sAccountFormat & "'"
    adoCmd.Execute
End Sub
                            
'得到账页的各列列宽
Public Function GetColWidth(ByVal sAccountType, ByVal sAccountFormat As String, _
                            ByVal sDefaultColWidth As String) As Integer()
    Dim rstTemp As ADODB.Recordset
    Dim adoCmd As ADODB.Command
    Dim sSQL As String
    Dim iColWidth() As Integer
    Dim sColWidth As String
    Dim i As Integer
    Dim j As Integer

    sColWidth = ""
    Set rstTemp = New ADODB.Recordset
    '取出该账页的各列宽度
    sSQL = "SELECT * FROM tUSU_AccountFormat" & _
            " WHERE AccountType = '" & sAccountType & "'" & _
            " AND AccountFormat = '" & sAccountFormat & "'"
    With rstTemp
        .CursorLocation = adUseClient
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If .RecordCount > 0 Then
            sColWidth = "" & Trim(.Fields("ColWidth").value)
        End If
    End With

    Set adoCmd = New ADODB.Command
    adoCmd.CommandType = adCmdText
    adoCmd.ActiveConnection = glo.cnnMain
    
    If sColWidth = "" Then
        '初始化账页的列宽
        sColWidth = sDefaultColWidth