mdlautoreturn.bas

来自「用友软件部分代码」· BAS 代码 · 共 83 行

Attribute VB_Name = "mdlAutoReturn"
Option Explicit
Private con As New ADODB.Connection
Private Rs As New ADODB.Recordset
Private sqlstr As String
Public Function checkPara() As Boolean
    Dim rq As String
    On Error GoTo Error0
    con.ConnectionString = zjLogInfo.UfDbName
    con.CursorLocation = adUseClient
    con.Open
    '判断自动还款是否启用
    If App.PrevInstance Then
        MsgBox "Already Exist!"
        checkPara = False
        GoTo Error0
        Exit Function
    End If
    
    sqlstr = "select max(dbill_date) As hkrq from fd_autoreturn;"
    Rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If Not (Rs.EOF Or Rs.BOF) Then
        If IsNull(Rs(0)) Then
            MsgBox "现在您不能执行自动还款操作！" & vbCrLf & "系统中没有需要自动还款的纪录或未记日记账！", vbInformation, "系统初始化错误"
            checkPara = False
            GoTo Error0
            Exit Function
        Else
            rq = Format(DateAdd("d", 1, CDate(Rs(0))), "YYYY/MM/DD")
        End If
    Else
         MsgBox "现在您不能执行自动还款操作！" & vbCrLf & "系统中没有需要自动还款的纪录或未记日记账！", vbInformation, "系统初始化错误"
         checkPara = False
         GoTo Error0
         Exit Function
    End If
    Rs.Close
    sqlstr = "select count(*) from fd_transactions where (to_date='" & rq & "') and (substring(transactions_id,1,2) in (select iId from fd_entities where fd_entities.iBIType='42'or iDeriveBIType = '42'))"
    sqlstr = sqlstr & " And (loan_flag='1')"
    Rs.Open sqlstr
    If Rs(0) > 0 Then
        MsgBox "系统已作过自动还款处理！" & vbCrLf & "请在下次记日记账后再执行本操作！", vbInformation, "系统初始化错误"
        checkPara = False
        Rs.Close
        GoTo Error0
        Exit Function
    End If
    Rs.Close
    sqlstr = "select * From Fd_Option;"
    Rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If Not IsNull(Rs("autoreturn_flag")) Then
        If Not Rs("autoreturn_flag") Then
            MsgBox "系统设置不允许自动还款！" & vbCrLf & "请在选项设置更改相应设置！", vbInformation, "自动还款"
            Rs.Close
            checkPara = False
            GoTo Error0
            Exit Function
        End If
    Else
        MsgBox "系统未设置自动还款选项！" & vbCrLf & "请在选项设置中做相应设置！", vbInformation, "自动还款"
        Rs.Close
        checkPara = False
        GoTo Error0
        Exit Function
    End If
    Rs.Close
    checkPara = True
    con.Close
    Set Rs = Nothing
    Set con = Nothing
    Exit Function
Error0:
    If Rs.State = adStateOpen Then
        Rs.Close
    End If
    'Set Rs = Nothing
    If con.State = adStateOpen Then
        con.Close
    End If
    'Set con = Nothing
    
End Function