billpublic.bas

金算盘软件代码

                        !lngReceiptNo = !lngReceiptNo + 1
                        .Update
                      Else
                        Select Case lngTypeID
                        Case 28, 29, 30, 31, 34 To 37, 39 To 52, 41, 54, 55 '凭证
                        Case Else
                            .Edit
                            !lngReceiptNo = !lngReceiptNo + 1
                            .Update
                        End Select
                      End If
                  
                End If
            End If
            strGetMaxNO = LTrim(strAlpha) & strNewMaxNo
        End With
EndProc:
        If Not recMaxNo Is Nothing Then
            recMaxNo.Close
            Set recMaxNo = Nothing
        End If
        Exit Function
ErrorHandler:
    strNewMaxNo = "0000"
    If Err.Number = 3197 Then    '当前记录已被别人修改 01S03: [Microsoft][ODBC 游标库] 没有更新或删除的数据行
         Resume ReOpen
    End If
    If Err.Number = 40002 Then '由于将在索引、 主关键字、或关系中创建重复的值，请求对表的改变没有成功。 改变该字段中的或包含重复数据的字段中的数据，删除索引或重新定义索引以允许重复的值并再试一次。
        Resume ReOpen
    End If
    Dim edtBill As ErrDealType
    edtBill = Errors.ErrorsDeal
    If edtBill = edtResume Then
       Resume ReOpen
    End If
    If edtBill = edtCanNotKnown Then
        Resume EndProc
    End If
    If edtBill = edtCanNotResume Then
       Resume EndProc
    End If
    If edtBill = edtResumeNext Then
       Resume EndProc
    End If
    
End Function
Public Function blnModifyMaxNO(ByVal intY As Integer, _
                    ByVal bytP As Byte, _
                    ByVal lngTypeID As Long, _
                    ByVal strAlpha As String, _
                    ByVal lngDigit As Long) As Boolean
'最大编号表维护(修改最大编号)
'新增或修改单据存盘时应调用本过程
'入口参数:
'        会计年度
'        会计期间
'        单据类型ID
'        单据编号字母部分
'        单据编号数字部分
'返回值:
'    修改成功为TRUE
'
    Dim recMaxNo As rdoResultset
    Dim strCriteria As String
    Dim strSQL As String
    
        If strAlpha = "" Then strAlpha = " "
        blnModifyMaxNO = False
        On Error GoTo ErrorHandler
        strCriteria = "intYear=" & intY & _
                " and bytPeriod=" & bytP & _
                " and lngReceiptTypeID=" & lngTypeID & _
                " and ' '||Ltrim(strReceiptNO)='" & " " & LTrim(strAlpha) & "'"
ReOpen:
        If Not recMaxNo Is Nothing Then
            Set recMaxNo = Nothing
        End If
        Set recMaxNo = gclsBase.BaseDB.OpenResultset("SELECT * FROM ReceiptMaxNo WHERE " & strCriteria, rdOpenDynamic, rdConcurValues)
        If recMaxNo Is Nothing Then
            Exit Function
        End If
        If Not recMaxNo.Updatable Then
'            MsgBox "最大编号表不能修改!)"
            recMaxNo.Close
            Set recMaxNo = Nothing
            Exit Function
        End If
        With recMaxNo
            If (.BOF And .EOF) Then
                strSQL = "INSERT INTO ReceiptMaxNo VALUES (" & intY & "," & _
                    bytP & "," & lngTypeID & ",'" & strAlpha & "'," & lngDigit & ")"
                gclsBase.BaseDB.Execute strSQL
            Else
                If CLng(Val(!lngReceiptNo)) < CLng(Val(lngDigit)) Then
'                    strSql = "UPDATE ReceiptMaxNo SET lngReceiptNo =" & lngDigit & " WHERE " & strCriteria
'                    gclsBase.BaseDB.Execute strSql
                    .Edit
                        !lngReceiptNo = lngDigit
                    .Update
                End If
            End If
        End With
    blnModifyMaxNO = True
EndProc:
    If Not recMaxNo Is Nothing Then
        recMaxNo.Close
        Set recMaxNo = Nothing
    End If
    Exit Function
ErrorHandler:
    If Err.Number = 3197 Then    '当前记录已被别人修改
         Resume ReOpen
    End If
    If Err.Number = 40002 Then    '当前记录已被别人修改
         Resume ReOpen
    End If
    blnModifyMaxNO = False
    Dim edtBill As ErrDealType
    edtBill = Errors.ErrorsDeal
    If edtBill = edtResume Then
       Resume EndProc
    End If
    If edtBill = edtCanNotKnown Then
       Resume EndProc
    End If
    If edtBill = edtCanNotResume Then
       Resume EndProc
    End If
    If edtBill = edtResumeNext Then
       Resume EndProc
    End If
    Resume EndProc
End Function
'''Public Function blnMaxNODecrease(ByVal intY As Integer, _
'''                    ByVal bytP As Byte, _
'''                    ByVal lngTypeID As Long, _
'''                    ByVal strAlpha As String, _
'''                    ByVal lngDigit As Long) As Boolean
''''最大编号表维护(修改最大编号)
''''新增单据放弃存盘时调用本过程，当最大编号与当前放弃单据编号相同时最大编号-1
''''入口参数:
''''        会计年度
''''        会计期间
''''        单据类型ID
''''        单据编号字母部分
''''        单据编号数字部分
''''返回值:
''''    修改成功为TRUE
''''
'''    Dim recMaxNo as rdoresultset
'''    Dim strCriteria As String
'''    Dim strSql As String
'''
'''        blnMaxNODecrease = False
'''        On Error GoTo ErrorHandler
'''        strCriteria = "intYear=" & intY & _
'''                " and bytPeriod=" & bytP & _
'''                " and lngReceiptTypeID=" & lngTypeID & _
'''                " and strReceiptNO='" & strAlpha & "'"
'''ReOpen:
'''        If Not recMaxNo Is Nothing Then
'''            Set recMaxNo = Nothing
'''        End If
'''        Set recMaxNo = gclsBase.BaseDB.OpenResultset("SELECT * FROM ReceiptMaxNo WHERE " & strCriteria, rdOpenDynamic, rdConcurValues)
'''        If recMaxNo Is Nothing Then
'''            Exit Function
'''        End If
'''        If Not recMaxNo.Updatable Then
'''            recMaxNo.Close
'''            Set recMaxNo = Nothing
'''            Exit Function
'''        End If
'''        With recMaxNo
'''            If .RecordCount > 0 Then
'''                If !lngReceiptNo = lngDigit And !lngReceiptNo > 0 Then
''''                    strSql = "UPDATE ReceiptMaxNo SET lngReceiptNo =" & (lngDigit - 1) & " WHERE " & strCriteria
''''                    gclsBase.BaseDB.Execute strSql
'''                    .Edit
'''                        !lngReceiptNo = lngDigit - 1
'''                    .Update
'''                End If
'''            End If
'''        End With
'''    blnMaxNODecrease = True
'''EndProc:
'''    If Not recMaxNo Is Nothing Then
'''        recMaxNo.Close
'''        Set recMaxNo = Nothing
'''    End If
'''    Exit Function
'''ErrorHandler:
'''    If Err.Number = 3197 Then    '当前记录已被别人修改
'''         Resume ReOpen
'''    End If
'''    blnMaxNODecrease = False
'''    Resume EndProc
'''End Function
'//////////////////////////////////////////////////////////////////////////////////////
Public Function blnMaxNODecrease(ByVal intY As Integer, ByVal bytP As Byte, _
                ByVal lngTypeID As Long, ByVal strAlpha As String, ByVal lngDigit As Long, _
                Optional ByVal blnOnlySubOne As Boolean = False) As Boolean
'最大编号表维护(修改最大编号)
'新增单据放弃存盘时调用本过程，当最大编号与当前放弃单据编号相同时最大编号-1
'入口参数:
'        会计年度
'        会计期间
'        单据类型ID
'        单据编号字母部分
'        单据编号数字部分
'返回值:
'    修改成功为TRUE
'
    Dim recMaxNo As rdoResultset
    Dim recMaxNoTmp As rdoResultset
    Dim strCriteria As String
    Dim strSQL As String
    
        If strAlpha = "" Then strAlpha = " "
        blnMaxNODecrease = False
        #If conDebug Then
        #Else
            On Error GoTo ErrorHandler
        #End If
        strCriteria = "intYear=" & intY & _
                " and bytPeriod=" & bytP & _
                " and lngReceiptTypeID=" & lngTypeID & _
                " and ' '||Ltrim(strReceiptNO)='" & " " & LTrim(strAlpha) & "'"
        Set recMaxNo = gclsBase.BaseDB.OpenResultset("SELECT * FROM ReceiptMaxNo WHERE " & strCriteria, rdOpenDynamic, rdConcurValues)
        If recMaxNo Is Nothing Then
            Exit Function
        End If
        If Not recMaxNo.Updatable Then
            recMaxNo.Close
            Set recMaxNo = Nothing
            Exit Function
        End If
        With recMaxNo
            If Not (.BOF And .EOF) Then
                If blnOnlySubOne = True Then '只减一
                    If !lngReceiptNo = lngDigit Then
                        .Edit
                            !lngReceiptNo = !lngReceiptNo - 1
                        .Update
                    End If
                    GoTo SubOne
                End If
                If !lngReceiptNo <= lngDigit Then   'And !lngReceiptNo > 0 Then
                    strSQL = "SELECT MAX(lngReceiptNO) FROM "
                    Select Case lngTypeID
                    Case 1
                        strSQL = strSQL & "PurchaseOrder WHERE intYear=" & intY & " and bytPeriod=" & bytP & " and ' '||Ltrim(strReceiptNO)='" & " " & LTrim(strAlpha) & "'"
                    Case 12
                        strSQL = strSQL & "SaleOrder WHERE intYear=" & intY & " and bytPeriod=" & bytP & " and ' '||Ltrim(strReceiptNO)='" & " " & LTrim(strAlpha) & "'"
                    Case 32
                        strSQL = strSQL & "CostPrice WHERE intYear=" & intY & " and bytPeriod=" & bytP & " and ' '||Ltrim(strReceiptNO)='" & " " & LTrim(strAlpha) & "'"
                    Case 33
                        strSQL = strSQL & "StockTaking WHERE intYear=" & intY & " and bytPeriod=" & bytP & " and ' '||Ltrim(strReceiptNO)='" & " " & LTrim(strAlpha) & "'"
                    Case 41, 54, 55
                        strSQL = "SELECT MAX(intVoucherNO) FROM Voucher WHERE intYear=" & intY & " and bytPeriod=" & bytP & " and lngVoucherTypeID=" & C2lng(strAlpha)
                    Case 34 To 40
                        strSQL = strSQL & "Activity WHERE lngActivityTypeID = " & lngTypeID & " AND intYear=" & intY & " and bytPeriod=" & bytP & " and ' '||Ltrim(strReceiptNO)='" & " " & LTrim(strAlpha) & "'"
                    Case 56
                        strSQL = strSQL & "Receive WHERE intYear=" & intY & " and bytPeriod=" & bytP & " and ' '||Ltrim(strReceiptNO)='" & " " & LTrim(strAlpha) & "'"
                    Case 57
                        strSQL = strSQL & "Polic WHERE intYear=" & intY & " and bytPeriod=" & bytP & " and ' '||Ltrim(strReceiptNO)='" & " " & LTrim(strAlpha) & "'"