userright.bas

金算盘软件代码

        For k = 0 To UBound(arrResult1)
            ReDim Preserve arrPost(intCount2) As Long
            arrPost(intCount2) = arrResult1(k) ' recRight!lngOperatorID
            intCount2 = intCount2 + 1
        Next
    ElseIf blnGroupAccount Then
        Dim arrResult2() As Long
        Dim i As Integer
        GetOperatorID arrResult2(), lngCurrentGroupNo
        For i = 0 To UBound(arrResult2)
            ReDim Preserve arrPost(intCount2) As Long
            arrPost(intCount2) = arrResult2(i) ' recRight!lngOperatorID
            intCount2 = intCount2 + 1
        Next
    ElseIf blnSigleAccount Then
        ReDim Preserve arrPost(intCount2) As Long
        arrPost(intCount2) = recRight!lngOperatorID
        intCount2 = intCount2 + 1
    End If
    '凭证复核
    If blnAllCheck Then
        Dim arrResult3() As Long
        Dim j As Integer
        GetOperatorID arrResult3()
        For j = 0 To UBound(arrResult3)
            ReDim Preserve arrChecker(intCount3) As Long
            arrChecker(intCount3) = arrResult3(j) 'recRight!lngOperatorID
            intCount3 = intCount3 + 1
        Next
    ElseIf blnGroupCheck Then
        Dim arrResult4() As Long
        Dim p As Integer
        GetOperatorID arrResult4(), lngCurrentGroupNo
        For p = 0 To UBound(arrResult4)
            ReDim Preserve arrChecker(intCount3) As Long
            arrChecker(intCount3) = arrResult4(p) ' recRight!lngOperatorID
            intCount3 = intCount3 + 1
        Next
    End If
End Function
Private Function GetOperatorID(arrResult() As Long, Optional OperatorGroupID = 0)
    Dim strSql As String
    Dim k As Integer
    Dim recTemplete As rdoResultset
    
    If OperatorGroupID = 0 Then
        strSql = "select lngOperatorID from operator "
    Else
        strSql = "select lngOperatorID from operator  where lngOperatorGroupID=" & OperatorGroupID
    End If
    Set recTemplete = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    k = 0
    Do Until recTemplete.EOF
        ReDim Preserve arrResult(k) As Long
        arrResult(k) = recTemplete(0)
        k = k + 1
        recTemplete.MoveNext
    Loop
End Function
'判断当前操作员能否执行作用操作员的权限
Public Function IsCanDo(ByVal RightID As Long, Optional OperatorID = 0) As Boolean
    'OperatorID -- 作用操作员  RightID -- 权限
    Dim UserID As Long, i As Integer
    Dim strSql As String, recRight As rdoResultset
    
    'zj (2000-02-15)
    '将查询他人单据的权限换为单据查询的权限
    '在权限表中不再保留查询他人单据的权限并理解为
    '有单据查询的权限则查询所有人的单据，否则为查询自己的单据
    '(因为有单据填制权限就有查询自己单据的权限)
    Select Case RightID
        Case 249                '查询他人凭证
            RightID = 28        '查询凭证
        Case 250                '查询他人应收单
            RightID = 37        '应收款项查询
        Case 251                '查询他人应付单
            RightID = 40        '应付款项查询
        Case 252                '查询他人其他收款单
            RightID = 44        '查询凭证
        Case 253                '查询他人其他付款单
            RightID = 46        '查询凭证
        Case 254                '查询他人固资变动单
            RightID = 120        '查询凭证
        Case 256                '查询他人采购订单
            RightID = 51        '查询凭证
        Case 257                '查询他人商品采购单
            #If conVersionType = 16 Then
                RightID = 213        '商品采购查询
            #Else
                RightID = 53        '商品采购查询
            #End If
        Case 258                '查询他人直运采购单
            RightID = 55        '直运采购查询
        Case 259                '查询他人受托入库单
            RightID = 57        '受托入库查询
        Case 260                '查询他人受托结算单
            RightID = 59        '受托结算查询
        Case 261                '查询他人采购发票
            RightID = 63        '采购发票查询
        Case 262                '查询他人销售订单
            RightID = 69        '销售订单查询
        Case 263                '查询他人商品销售单
            #If conVersionType = 16 Then
                RightID = 215        '商品销售查询
            #Else
                RightID = 71        '商品销售查询
            #End If
        Case 264                '查询他人直运销售单
            RightID = 73        '直运销售查询
        Case 265                '查询他人委托出库单
            RightID = 75        '委托出库查询
        Case 266                '查询他人委托结算单
            RightID = 77        '委托结算查询
        Case 267                '查询他人委托调拨单
            RightID = 81        '委托调拨查询
        Case 268                '查询他人销售发票
            RightID = 125        '销售发票查询
        Case 269                '查询他人分期出库单
            RightID = 83        '分期收款发出商品查询
        Case 270                '查询他人分期结算单
            RightID = 85        '分期发出商品结算查询
        Case 271                '查询他人商品调拨单
            RightID = 89        '商品调拨查询
        Case 272                '查询他人商品调价单
            RightID = 91        '商品调价查询
        Case 273                '查询他人商品盘点表
            RightID = 93        '商品盘点查询
        Case 274                '查询他人拆卸组装单
            RightID = 95        '拆卸组装查询
        Case 275                '查询他人自制入库单
            RightID = 97        '自制入库查询
        Case 276                '查询他人其它入库单
            RightID = 99        '其它入库查询
        Case 277                '查询他人领用出库单
            RightID = 101       '领用出库查询
        Case 278                '查询他人其它出库单
            RightID = 103       '其它出库查询
        Case 279                '查询他人入库成本单
            RightID = 111       '入库成本查询
        Case 280                '查询他人成本调整单
            RightID = 127       '成本调整查询
        Case 281                '查询他人盘盈入库单
            RightID = 129       '盘盈入库查询
        Case 282                '查询他人盘亏出库单
            RightID = 131       '盘亏出库查询
        Case 283                '查询他人加工出库单
            RightID = 105       '加工出库查询
        Case 284                '查询他人加工入库单
            RightID = 107       '加工入库查询
        Case 285                '查询他人加工费用单
            RightID = 109       '加工费用查询
        Case 296                '查询他人职工开户单
            RightID = 295       '职工开户单查询
        Case 299                '查询他人职工销户单
            RightID = 298       '职工销户单查询
        Case 302                '查询他人调如调出单
            RightID = 301       '调入调出单查询
        Case 305                '查询他人封存单
            RightID = 304       '职工封存单查询
        Case 308                '查询他人启封单
            RightID = 307       '职工启封单查询
        Case 311                '查询他人保费汇缴单
            RightID = 310       '保费汇缴单查询
        Case 314                '查询他人保费补缴单
            RightID = 313       '保费补缴单查询
        Case 317                '查询他人费用结算单
            RightID = 316       '费用结算单查询
        Case 451                '查询他人采购发票
            RightID = 213       '商品采购查询
        Case 452                '查询他人销售发票
            RightID = 215       '商品销售查询
        Case 473                '查询他人销售收款
            RightID = 470       '销售收款查询
        Case 474                '查询他人采购付款
            RightID = 472       '采购付款查询
    End Select
    #If conVersionType = 16 Then
        If RightID = 52 Or RightID = 62 Then RightID = 212
        If RightID = 53 Or RightID = 63 Then RightID = 213
        If RightID = 70 Or RightID = 124 Then RightID = 214
        If RightID = 71 Or RightID = 125 Then RightID = 215
        If RightID = 237 Then RightID = 286
        If RightID = 238 Then RightID = 287
    #End If
    IsCanDo = True
    For i = 1 To UBound(marrRight)
        If RightID = marrRight(i, 0) Then Exit For
    Next i
    If i > UBound(marrRight) Then     '当前操作员不拥有该权限
        IsCanDo = False
        Exit Function
    End If
    UserID = gclsBase.OperatorID
    If UserID = OperatorID Then
        '判定加密狗中是否有此权限
        If ExistInDog Then
            If gAllInFormation Then Exit Function '全狗
            If Not IsUseRightByDog(RightID) Then IsCanDo = False
        End If
        Exit Function  '当前操作员就是作用操作员
    End If
    strSql = "SELECT lngOperatorGroupID AS GroupID FROM Operator WHERE" _
        & " lngOperatorID=" & OperatorID
    Set recRight = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recRight.EOF Then
        '判定加密狗中是否有此权限
        If ExistInDog Then
            If gAllInFormation Then Exit Function '全狗
            If Not IsUseRightByDog(RightID) Then IsCanDo = False
        End If
        Exit Function     '作用操作员不存在
    End If
    Dim OperatorGroup As Long     '作用操作员所在操作员组
    OperatorGroup = recRight!GroupID
    strSql = "SELECT lngOperatorGroupID AS GroupID FROM Operator WHERE" _
        & " lngOperatorID=" & UserID
    Set recRight = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    '当前操作员与作用操作员不同组
    If recRight!GroupID <> OperatorGroup Then IsCanDo = False
    '判定加密狗中是否有此权限
    If ExistInDog Then
        If gAllInFormation Then Exit Function '全狗
        If Not IsUseRightByDog(RightID) Then IsCanDo = False
    End If
End Function

Public Function ShowWarnList() As Boolean
    Dim strSql As String
    Dim recTemplete As rdoResultset
    
    strSql = "SELECT * FROM Note  WHERE Note.strdate <= To_Char(To_Date('" & Format(gclsBase.BaseDate, "yyyy-mm-dd") & "','RRRR-MM-DD')+Note.bytDay,'RRRR-MM-DD') and Note.blnIsDoned=0 and (Note.lngExecutantID=0 OR Note.lngExecutantID=" & gclsBase.OperatorID & ")"
    Set recTemplete = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemplete.RowCount > 0 Then
        frmWarnList.BindingResultSet
    End If
End Function
Public Function DefaultWhere(intFormType As Integer, lngListID As Long) As Boolean
    Dim strSql As String
    Dim BeginDate As Date