?? 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -