modpurview.bas

销售预测系统

Attribute VB_Name = "modPurview"
'****************************************************************************************
' MODULE        : modPurview
' DESCRIPTION   :
' CREATE        : Whorter 2001/09/16
' FUNCTION      :
' USAGE         :
'****************************************************************************************
Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''
' 错误信息
Dim m_tagErrInfo As TYPE_ERRORINFO

'**************************************************************
'1. 公共数据类型定义
'**************************************************************
'''''''''''''''''''''''''''''''''''''''''

Public Type TYPE_PURVIEW
    object_name As String   '窗体名称
    index As String
    pur_query As String * 2
    pur_insert As String * 2
    pur_update As String * 2
    pur_delete As String * 2
End Type

'Public g_UserPurview() As TYPE_PURVIEW  '用于存储
Public g_blnSysAdmin As Boolean         '是否为系统管理员身份
Public g_nUser_Id As Integer             '登陆用户编号
Public g_strEmp_Code As String       '登陆用户的员工编号
Public g_nSA_User_Id As Integer

'得到用户组ID
Public Function GetUserGroupID(UserGroupName As String, GroupID As Integer) As Boolean
    On Error GoTo ERROR_EXIT
    Dim rs As New ADODB.Recordset
    rs.Open "SELECT * FROM UserGroups WHERE group_name = '" & UserGroupName & "'", dbMyDB, adOpenStatic, adLockReadOnly
    If rs.RecordCount <> 1 Then GoTo ERROR_EXIT
    GroupID = rs!group_id
    rs.Close
    Set rs = Nothing
    GetUserGroupID = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modPurview"
    m_tagErrInfo.strErrFunc = "GetUserGroupID"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "得到用户组ID和用户组的系统名称失败。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    'GroupSysName = ""
    GroupID = 0
    If rs.State = adStateOpen Then
        rs.Close
        Set rs = Nothing
    End If
    GetUserGroupID = False
End Function

'得到用户ID
Public Function GetUserID(strUserName As String, intUserID As Integer, Optional strEmpCode As String, Optional intSaUserId As Integer) As Boolean
    On Error GoTo ERROR_EXIT
    Dim rs As New ADODB.Recordset
    rs.Open "SELECT * FROM Users WHERE my_user_name = '" & strUserName & "'", dbMyDB, adOpenStatic, adLockReadOnly
'    If rs.RecordCount <> 1 Then GoTo ERROR_EXIT
    If rs.RecordCount = 1 Then
        intUserID = rs!my_user_id
        strEmpCode = rs!emp_code
    ElseIf rs.RecordCount = 0 Then
        rs.Close
        rs.Open "SELECT * FROM Users_Admin WHERE admin_user_name = '" & strUserName & "'", dbMyDB, adOpenStatic, adLockReadOnly
        intUserID = 0
        If rs.RecordCount <> 1 Then GoTo ERROR_EXIT
        rs.MoveFirst
        If IsNull(rs!emp_code) Then
            strEmpCode = ""
        Else
            strEmpCode = rs!emp_code
        End If
    End If
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    GetUserID = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modPurview"
    m_tagErrInfo.strErrFunc = "GetUserID"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number) & "得到用户ID和用户的系统名称失败。"
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
NON_EXIT:
    intUserID = 0
    If rs.State = adStateOpen Then
        rs.Close
    End If
    Set rs = Nothing
    GetUserID = False
End Function

'在系统加载时，加载用户权限
'权限检索成功后，如果无权限则返回 blnPurview = False , 函数返回 True
'Public Function LoadUserPurview(ByRef strUserName As String, ByRef blnPurview As Boolean) As Boolean
'    On Error GoTo ERROR_EXIT
'    Dim rsPurview As New ADODB.Recordset
'    Dim i As Integer
'    rsPurview.Open "SELECT * FROM VIEW_UserPurview WHERE my_user_name = '" & _
'                    Trim(strUserName) & "' ORDER BY user_purview_index", dbMyDB, adOpenStatic, adLockReadOnly
'    If rsPurview.RecordCount < 1 Then
'        blnPurview = False
'        GoTo NOPURVIEW_EXIT   '用户无任何权限，退出系统
'    End If
'    ReDim g_UserPurview(0)
'    rsPurview.MoveFirst
'    i = 0
'    Do While Not rsPurview.EOF
'        If i = 0 Then
'            g_UserPurview(0).object_name = Trim(rsPurview!my_object_name)
'            g_UserPurview(0).index = Trim(rsPurview!user_purview_index)
'            Select Case Right(rsPurview!user_purview_index, 1)
'                Case "D"
'                    g_UserPurview(0).pur_delete = rsPurview!user_purview
'                Case "I"
'                    g_UserPurview(0).pur_insert = rsPurview!user_purview
'                Case "Q"
'                    g_UserPurview(0).pur_query = rsPurview!user_purview
'                Case "U"
'                    g_UserPurview(0).pur_update = rsPurview!user_purview
'                Case Else
'                    GoTo ERROR_EXIT
'            End Select
'            i = 1
'        Else
'            If g_UserPurview(i - 1).object_name <> Trim(rsPurview!my_object_name) Then
'                ReDim Preserve g_UserPurview(i)
'                g_UserPurview(i).object_name = Trim(rsPurview!my_object_name)
'                g_UserPurview(i).index = Trim(rsPurview!user_purview_index)
'                Select Case Right(rsPurview!user_purview_index, 1)
'                    Case "D"
'                        g_UserPurview(i).pur_delete = rsPurview!user_purview
'                    Case "I"
'                        g_UserPurview(i).pur_insert = rsPurview!user_purview
'                    Case "Q"
'                        g_UserPurview(i).pur_query = rsPurview!user_purview
'                    Case "U"
'                        g_UserPurview(i).pur_update = rsPurview!user_purview
'                    Case Else
'                        GoTo ERROR_EXIT
'                End Select
'                i = i + 1
'            Else
'                Select Case Right(rsPurview!user_purview_index, 1)
'                    Case "D"
'                        g_UserPurview(i - 1).pur_delete = rsPurview!user_purview
'                    Case "I"
'                        g_UserPurview(i - 1).pur_insert = rsPurview!user_purview
'                    Case "Q"
'                        g_UserPurview(i - 1).pur_query = rsPurview!user_purview
'                    Case "U"
'                        g_UserPurview(i - 1).pur_update = rsPurview!user_purview
'                    Case Else
'                        GoTo ERROR_EXIT
'                End Select
'            End If
'        End If
'        rsPurview.MoveNext
'    Loop
'    If rsPurview.State = adStateOpen Then rsPurview.Close
'    Set rsPurview = Nothing
'    blnPurview = True
'    LoadUserPurview = True
'    Exit Function
'ERROR_EXIT:
'    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
'    m_tagErrInfo.strErrFile = "modPurview"
'    m_tagErrInfo.strErrFunc = "LoadUserPurview"
'    m_tagErrInfo.nErrNum = Err.Number
'    m_tagErrInfo.strErrDesc = Error(Err.Number)
'    If Err.Number <> 0 Then Err.Clear
'    modErrorInfo.WriteErrLog m_tagErrInfo
'
'    If rsPurview.State = adStateOpen Then rsPurview.Close
'    Set rsPurview = Nothing
'    LoadUserPurview = False
'    Exit Function
'NOPURVIEW_EXIT:
'    If rsPurview.State = adStateOpen Then rsPurview.Close
'    Set rsPurview = Nothing
'    blnPurview = False
'    LoadUserPurview = True
'End Function

Public Function SetPower(FormName As String, strQuery As String, fDelete As Boolean, fInsert As Boolean, fChange As Boolean) As Boolean
    On Error GoTo ERROR_EXIT
    
    Dim cmd As New ADODB.Command
    Dim rs As New ADODB.Recordset
    Dim strSQL As String
   
'    strSQL = "SELECT user_purview FROM UserPurview WHERE my_object_name='" & FormName & "' AND my_user_id='" & g_nUser_Id & "'"
    strSQL = "SELECT user_purview FROM UserPurview,IndexToObject WHERE object='" & FormName & "' AND index_object=my_object_name AND my_user_id=" & g_nUser_Id & ""

    cmd.ActiveConnection = dbMyDB
    cmd.CommandText = strSQL
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    
    '判断查询是否成功
    If rs.State <> adStateOpen Then GoTo ERROR_EXIT
    rs.MoveFirst
    While Not rs.EOF
        Select Case rs!user_purview
            Case "PQ"
                strQuery = "PQ"        '个人读
            Case "AQ"
                strQuery = "AQ"        '全局读
            Case "PD", "AD"
                fDelete = True
            Case "PI", "AI"
                fInsert = True
            Case "PU", "AU"
                fChange = True
        End Select
        rs.MoveNext
    Wend
    
    rs.Close
    Set cmd = Nothing
    SetPower = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modPurview"
    m_tagErrInfo.strErrFunc = "SetPower"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    rs.Close
    Set cmd = Nothing
    SetPower = False
End Function