userright.bas

金算盘软件代码

Attribute VB_Name = "UserRight"
'权限组模块
'Modual about rights
'      作者：欧中建
'      日期：1998.6.10
'设置每一个操作员拥有的权限属于哪一个权限组
'（因为    权限被分为许多个组）
Option Explicit
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
        ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private marrRight() As Variant              '权限数组
Private mkblnIsShowCard(3) As Boolean
Private mintVersionNo As Integer
Private mintListType As Integer
Public gclsList As New Collection
Private marrAccount() As Variant            '用户科目
Private mblnIsFirstInit As Boolean          '是否初始化
Private lngOldOperator As Long              '老的操作员
Private mblnAllAccount As Boolean           '是否具有全部科目

'初始化操作员的科目（仅对当前操作员）
Public Sub InitOperatorAccount(ByVal lngOperatorID As Long)
    Dim recTmp As rdoResultset
    Dim strSql As String
    Dim i As Long
    
    If lngOperatorID <> gclsBase.OperatorID Then Exit Sub
    strSql = "Select blnAllAccount as blnUse from Operator Where lngOperatorID=" & lngOperatorID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTmp.EOF Then
        mblnAllAccount = False
    Else
        mblnAllAccount = recTmp!blnUse
    End If
    recTmp.Close
    Set recTmp = Nothing
    If mblnAllAccount Then Exit Sub
    strSql = " Select lngAccountID as AccountID From OperatorAccount where lngOperatorID=" & lngOperatorID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTmp.EOF Then
        ReDim marrAccount(0)
        Exit Sub
    End If
    mblnIsFirstInit = False
    recTmp.MoveLast
    ReDim marrAccount(1 To recTmp.RowCount)
    recTmp.MoveFirst
    mblnIsFirstInit = True
    For i = 1 To recTmp.RowCount
        marrAccount(i) = recTmp!AccountID
        recTmp.MoveNext
    Next i
    lngOldOperator = lngOperatorID
    recTmp.Close
    Set recTmp = Nothing
End Sub
'判定操作员是否具有此科目
'Whether or not Having right on using a certain Account
Public Function HasAccount(ByVal lngAccountID As Long) As Boolean
    Dim OperatorID As Long
    HasAccount = False
    If mblnAllAccount Then
        HasAccount = mblnAllAccount
        Exit Function
    End If
    Dim i As Long
    For i = 1 To UBound(marrAccount)
        If lngAccountID = marrAccount(i) Then
            HasAccount = True
            Exit For
        End If
    Next i
    If i > UBound(marrAccount) Then     '当前操作员不拥有该权限
        HasAccount = False
        Exit Function
    End If
End Function

Public Function blnHavingInorOut() As Boolean
    Dim strByteName As String
    Dim strDefault As String
    Dim strTmpValue As String
    Dim lngSize As Long
    Dim strByteKey As String
    Dim strININame As String
    Dim lngTmp As Long
    #If conVersionType = 1 Then
        strByteName = "金算盘软件" '"金算盘商务管理软件标准版"
    #Else
        #If conVersionType = 2 Then
            strByteName = "金算盘商务管理软件行政事业版"
        #Else
            #If conVersionType = 4 Then
                strByteName = "金算盘商务管理软件实达专用版"
            #Else
                #If conVersionType = 8 Then
                    strByteName = "金算盘商务管理软件标准版"
                #End If
            #End If
        #End If
    #End If
    strByteName = "金算盘软件"
    blnHavingInorOut = False
    strDefault = "JJ9800ZZ001"
    strTmpValue = Space(255)
    lngSize = Len(strTmpValue)
    strByteKey = "AccountData"
    If Right(App.Path, 2) = ":\" Then
        strININame = App.Path & "Account.ini"
    Else
        strININame = App.Path & "\Account.ini"
    End If
    If Dir(strININame) <> "" Then
        lngTmp = GetPrivateProfileString(strByteName, strByteKey, strDefault, strTmpValue, lngSize, strININame)
        If lngTmp > 0 Then
            If Left(strTmpValue, lngTmp) = "1" Then blnHavingInorOut = True
        End If
    End If
    
End Function
Public Function GetVersionType() As Integer
    #If conVersionType = 1 Then
        GetVersionType = 1
    #ElseIf conVersionType = 2 Then
        GetVersionType = 2
    #ElseIf conVersionType = 4 Then
        GetVersionType = 4
    #ElseIf conVersionType = 8 Then
        GetVersionType = 8
    #ElseIf conVersionType = 16 Then
        GetVersionType = 16
    #End If
End Function

'把当前操作员拥有的权限取到一个集合中,可包括作用操作员的权限
Public Sub GetRight()
    Dim strSql As String, recRight As rdoResultset
    Dim i As Integer
    
'    strSql = "SELECT RightGroupDetail.lngRightID AS RightID,Right.strMenuName" & _
'     " AS strMenuName FROM ([Right] LEFT JOIN RightGroupDetail ON" & _
'     " RightGroupDetail.lngRightID=Right.lngRightID) LEFT JOIN OperatorRight" & _
'     " ON OperatorRight.lngRightGroupID=RightGroupDetail.lngRightGroupID WHERE" & _
'     " OperatorRight.lngOperatorID =" & gclsBase.OperatorID & " And (ISNULL(Right.strNotVersionNO) or Instr(1,Right.strNotVersionNo,'" & GetVersionType & ",' )=0)"
    strSql = "SELECT RightGroupDetail.lngRightID AS RightID,Right.strMenuName" & _
     " AS strMenuName FROM Right,RightGroupDetail,OperatorRight Where (" & _
     " RightGroupDetail.lngRightID(+)=Right.lngRightID) " & _
     " And OperatorRight.lngRightGroupID(+)=RightGroupDetail.lngRightGroupID AND " & _
     " OperatorRight.lngOperatorID =" & gclsBase.OperatorID & " And Instr(Right.strNotVersionNo,'" & GetVersionType & ",' )=0"
    Set recRight = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recRight.EOF Then
        ReDim marrRight(0)
        Exit Sub
    End If
    recRight.MoveLast
    ReDim marrRight(1 To recRight.RowCount, 1)
    recRight.MoveFirst
    For i = 1 To recRight.RowCount
        marrRight(i, 0) = recRight!RightID
        marrRight(i, 1) = recRight!strMenuName
        recRight.MoveNext
    Next i
End Sub

''取得当前操作员可产生作用的操作操作员数组
Public Function GetGroupOperator(ByVal OperatorID As Long, arrOperator() As Long, _
    arrChecker() As Long, arrPost() As Long) As Boolean
    Dim strSql As String
    Dim blnSigleAccount As Boolean
    Dim blnAllAccount As Boolean
    Dim blnGroupAccount As Boolean
    Dim blnAllCheck As Boolean
    Dim blnGroupCheck As Boolean
    Dim recRight As rdoResultset
    Dim recGroup As rdoResultset
    Dim intCount1 As Integer
    Dim intCount2 As Integer
    Dim intCount3 As Integer
    Dim lngCurrentGroupNo As Long

    GetGroupOperator = True
    blnSigleAccount = False
    blnAllAccount = False
    blnGroupAccount = False
    blnAllCheck = False
    blnGroupCheck = False
  
'  strSql = "Select Operator.lngOperatorID,Operator.lngOperatorGroupID,Right.strRightName" & _
'        " From ((Operator Inner Join OperatorRight ON" & _
'        " OperatorRight.lngOperatorID=Operator.lngOperatorID)" & _
'        " Inner Join RightGroupDetail ON " & _
'        " RightGroupDetail.lngRightGroupID=OperatorRight.lngRightGroupID)" & _
'        " Inner Join [Right] " & _
'        " ON Right.lngRightID=RightGroupDetail.lngRightID" & _
'        " WHERE Right.strRightName In " & _
'        "( '填制凭证','小组凭证复核','全部凭证复核','个人凭证记帐','小组凭证记帐','全部凭证记帐')" & _
'        " And Operator.lngOperatorID=" & OperatorID
    strSql = "Select Operator.lngOperatorID,Operator.lngOperatorGroupID,Right.strRightName" & _
        " From Operator,OperatorRight,RightGroupDetail,Right " & _
        " Where (OperatorRight.lngOperatorID=Operator.lngOperatorID" & _
        " AND RightGroupDetail.lngRightGroupID=OperatorRight.lngRightGroupID" & _
        " AND Right.lngRightID=RightGroupDetail.lngRightID)" & _
        " AND Right.strRightName In " & _
        "( '填制凭证','小组凭证复核','全部凭证复核','个人凭证记帐','小组凭证记帐','全部凭证记帐')" & _
        " And Operator.lngOperatorID=" & OperatorID
    Set recRight = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recRight.EOF Then
      GetGroupOperator = False
      Exit Function
    End If
    intCount1 = 0
    intCount2 = 0
    intCount3 = 0
    Do While Not recRight.EOF
        Select Case recRight!strRightName
            Case "填制凭证"
                ReDim Preserve arrOperator(intCount1) As Long
                arrOperator(intCount1) = recRight!lngOperatorID
                intCount1 = intCount1 + 1
            Case "个人凭证记帐"
                blnSigleAccount = True
            Case "小组凭证记帐"
                blnGroupAccount = True
                lngCurrentGroupNo = recRight!lngOperatorGroupID
            Case "全部凭证记帐"
                blnAllAccount = True
            Case "小组凭证复核"
                blnGroupCheck = True
                lngCurrentGroupNo = recRight!lngOperatorGroupID
            Case "全部凭证复核"
                blnAllCheck = True
        End Select
        recRight.MoveNext
    Loop
    '凭证记帐
    If blnAllAccount Then
        Dim arrResult1() As Long
        Dim k As Integer
        GetOperatorID arrResult1()