clschecksystel.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 = "clsCheckSystel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'检查系统
Public Function bCheckSystel(ByVal vsType As String) As Boolean
    bCheckSystel = False
'    If bCheckTotal(vsTable) = False Then Exit Function
'    If bCheckData(vsType) = False Then Exit Function
    If gbChequeLine = False Then
        If bCheckReport(vsType) = True Then Exit Function
    End If
    bCheckSystel = True
End Function

'检查总数是否正确
Private Function bCheckTotal(vsTable As String) As Boolean
On Error GoTo err
    Dim StrSQL As String
    Dim recTotal As ADODB.Recordset
    Dim iTotal As Integer
    Dim recMax As ADODB.Recordset
    
    bCheckTotal = False
    StrSQL = "select count(*) from " + gsconTabel + vsTable
    Set recTotal = gConn.Execute(StrSQL)
    
    iTotal = recTotal.Fields(0)
    iTotal = iTotal + 1
    
    Set recMax = New ADODB.Recordset
    StrSQL = "select id from " + gsconTabel + vsTable + " where id =" + CStr(iTotal)
    If recMax.State = 1 Then recMax.Close
    recMax.Open StrSQL, gConn, adOpenStatic, adLockReadOnly
    
    If recMax.RecordCount > 0 Then
        Exit Function
    End If
    
    bCheckTotal = True
    Exit Function
err:

    MsgBox "您的开票信息有误，请与供应商联系！", vbOKOnly + vbInformation, "提示信息"
End Function

Private Function bCheckData(vsType As String) As Boolean
On Error GoTo err
    Dim StrSQL As String
    Dim recData As ADODB.Recordset
    Dim sTable As String
    Dim sWhere As String
    Dim objEncry As New encrypt
    Dim sErr As String
    Dim dNum As Double
    
    bCheckData = False
    
    If vsType = "B" Then
        sTable = " buildcheque"
    ElseIf vsType = "E" Then
        sTable = " estatecheque "
        sWhere = " and (estatecode <>'' and estatecode is not null)"
    Else
        sTable = "commoncheque"
    End If
    
    StrSQL = "select totalmoney from " + gsconTabel + sTable + _
             " where itemname <>'' and itemname is not null" + sWhere
    Set recData = New ADODB.Recordset
    If recData.State = 1 Then recData.Close
    recData.Open StrSQL, gConn, adOpenStatic, adLockReadOnly
    
    If recData.RecordCount = 0 Then
        bCheckData = True
        Exit Function
    End If
    
On Error GoTo ErrData
    Do Until recData.EOF
        dNum = CDbl(objEncry.unencrypt_str(recData.Fields(0), "12345678", sErr))
        recData.MoveNext
        If sErr <> "" Then
            MsgBox "您的数据有误，请与供应商联系！", vbOKOnly + vbInformation, "提示信息"
            Exit Function
        End If
    Loop
    
    bCheckData = True
    Exit Function
err:

    MsgBox "数据检查失败，请确认！", vbOKOnly + vbInformation, "提示信息"
ErrData:

    MsgBox "您的数据有误，请与供应商联系！", vbOKOnly + vbInformation, "提示信息"
End Function

'检查数据是否上报
Private Function bCheckReport(vsType As String) As Boolean
On Error GoTo err
    Dim StrSQL As String
    Dim recData As ADODB.Recordset
    Dim sTable As String
    Dim sDate As String
    
    bCheckReport = False
    
    If vsType = "B" Then
        sTable = " buildchequeinfo "
    ElseIf vsType = "E" Then
        sTable = " estatechequeinfo "
    Else
        sTable = " commonchequeinfo "
    End If
      
    If Format(Now, "dd") < 10 Then Exit Function                             '''到了10号才检查数据是否上报
    
    sDate = Format(Now, "yyyy-mm") + "-01"
    
    StrSQL = "select count(*) from " + gsconTabel + sTable + _
             " where opencheque ='Y' and (datareport  <> 'Y' or datareport is null)" + _
                " and chequedate < '" + sDate + "'"
    Set recData = gConn.Execute(StrSQL)
    
    If recData.Fields(0) > 0 Then
        If Format(Now, "dd") < 15 Then                                        '''如果还没有到15号提示用户上报数据，如果到了15号将会锁住系统
            MsgBox "您上个月的数据还没有上报，如果在15号之前数据不" + _
                    "上报，系统将会启动加锁功能，请确认！", vbOKOnly + vbInformation, "提示信息"
            Exit Function
        End If
        bCheckReport = True
        Exit Function
    End If
    
    Exit Function
err:

    MsgBox "您的数据有误，请与供应商联系！", vbOKOnly + vbInformation, "提示信息"
End Function