【原创】LS程序 - 对于Lotus Notes数据库中文档的访问控制
2008-05-20 10:46
323 查看
程序原义是想用在控制对文档的读写控制上。但是扩展后可以用在多个地方,比如对于button和其他元素的一些控制
针对复杂的文档读写控制,比如角色的基础上,还需要对不同状态情况下文档读写控制,这个function将大大减少程序的复杂程度。
如下
Function toaccess (obj1 As Variant, chars As Variant , obj2 As String, equal As String) As Boolean
On Error Goto sl
'=====================================================================================================================
' This program is use to check if user have access to current object, such as button, form, view or others
' obj1 is current user or current object, normally, it would be user id or someone 's userid
' obj2 is the fixed parament, such as role, or namelist group or other related works.
'
' "obj2" include:
' "ACL"
' "mutli-value"
' "string"
' "number"
'
' equal is character to identify how to compare the obj1 and obj2. such as
' toaccess(notessession.commonusername,"[Admin]","=")
' it mean, if current user is Admin, the toaccess is true, or false
' toaccess("123",numberlist,"contain")
' it mean, if contain, true, or false
'
' "equal" include:
' "="
' "<>"
' ">"
' "<"
' "contain"
' "notcontain"
'
' Programmer: Jacky Shu
' Date: 2008-05-13
'
'
'
'
'====================================================================================================================
Dim ss As New NotesSession
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
' defult value of toaccess is false
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If obj2 = "ACL" Then
' In ACL type, the equal parament only have two: contain / notcontain
If equal <> "contain" And equal <> "notcontain" Then
ReturnMsg("toaccess_parament_error")
Exit Function
End If
' ========================================Function Module 1 =============================================
Dim db As NotesDatabase
Dim aclx As NotesACL
Dim entry As NotesACLEntry
Set db = ss.CurrentDatabase
Set aclx = db.ACL
Set entry = aclx.GetEntry(obj1)
If equal = "contain" Then
Forall r In entry.Roles
If r = chars Then
toaccess = True
Exit Function
End If
End Forall
toaccess = False
Exit Function
End If
If equal = "notcontain" Then
Forall r In entry.Roles
If r = chars Then
toaccess = False
Exit Function
End If
End Forall
toaccess = True
Exit Function
End If
Exit Function
End If
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If obj2 = "mutli-value" Then
' In mutli-value type, the equal parament only have two: contain / notcontain
If equal <> "contain" And equal <> "notcontain" Then
ReturnMsg("toaccess_parament_error")
Exit Function
End If
' ========================================Function Module 2 =============================================
If equal = "notcontain" Then
Forall r In obj1
If r = chars Then
toaccess = False
Exit Function
End If
End Forall
toaccess = True
Exit Function
End If
If equal = "contain" Then
Forall r In obj1
If r = chars Then
toaccess = True
Exit Function
End If
End Forall
toaccess = False
Exit Function
End If
Exit Function
End If
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If obj2 = "string" Then
' In string type, the equal parament only have two: contain / notcontain / = / <>
If equal <> "contain" And equal <> "notcontain" And equal <> "=" And equal <> "<>" Then
ReturnMsg("toaccess_parament_error")
Exit Function
End If
' ========================================Function Module 3 =============================================
If equal = "contain" Then
If Instr(obj1,chars) > 0 Then
toaccess = True
Exit Function
End If
End If
If equal = "notcontain" Then
If Instr(obj1,chars) = 0 Then
toaccess = True
Exit Fu
a38b
nction
End If
End If
If equal = "=" Then
If obj1 = chars Then
toaccess = True
Exit Function
End If
End If
If equal = "<>" Then
If obj1 <> chars Then
toaccess = True
Exit Function
End If
End If
toaccess = False
Exit Function
End If
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If obj2 = "number" Then
' In number type, the equal parament only have two: > / < / = / <>
If equal <> ">" And equal <> "<" And equal <> "=" And equal <> "<>" Then
ReturnMsg("toaccess_parament_error")
Exit Function
End If
' ========================================Function Module 4 =============================================
If equal = "<" Then
If Cint(obj1) < Cint(chars) Then
toaccess = True
Exit Function
End If
End If
If equal = ">" Then
If Cint(obj1) > Cint(chars) Then
toaccess = True
Exit Function
End If
End If
If equal = "=" Then
If Cint(obj1) = Cint(chars) Then
toaccess = True
Exit Function
End If
End If
If equal = "<>" Then
If Cint(obj1) <> Cint(chars) Then
toaccess = True
Exit Function
End If
End If
toaccess = False
Exit Function
End If
sl:
Msgbox "Error Message is : " & Error & Chr(13) & Chr(13) & "error line is : " & Erl
End Function
针对复杂的文档读写控制,比如角色的基础上,还需要对不同状态情况下文档读写控制,这个function将大大减少程序的复杂程度。
如下
Function toaccess (obj1 As Variant, chars As Variant , obj2 As String, equal As String) As Boolean
On Error Goto sl
'=====================================================================================================================
' This program is use to check if user have access to current object, such as button, form, view or others
' obj1 is current user or current object, normally, it would be user id or someone 's userid
' obj2 is the fixed parament, such as role, or namelist group or other related works.
'
' "obj2" include:
' "ACL"
' "mutli-value"
' "string"
' "number"
'
' equal is character to identify how to compare the obj1 and obj2. such as
' toaccess(notessession.commonusername,"[Admin]","=")
' it mean, if current user is Admin, the toaccess is true, or false
' toaccess("123",numberlist,"contain")
' it mean, if contain, true, or false
'
' "equal" include:
' "="
' "<>"
' ">"
' "<"
' "contain"
' "notcontain"
'
' Programmer: Jacky Shu
' Date: 2008-05-13
'
'
'
'
'====================================================================================================================
Dim ss As New NotesSession
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
' defult value of toaccess is false
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If obj2 = "ACL" Then
' In ACL type, the equal parament only have two: contain / notcontain
If equal <> "contain" And equal <> "notcontain" Then
ReturnMsg("toaccess_parament_error")
Exit Function
End If
' ========================================Function Module 1 =============================================
Dim db As NotesDatabase
Dim aclx As NotesACL
Dim entry As NotesACLEntry
Set db = ss.CurrentDatabase
Set aclx = db.ACL
Set entry = aclx.GetEntry(obj1)
If equal = "contain" Then
Forall r In entry.Roles
If r = chars Then
toaccess = True
Exit Function
End If
End Forall
toaccess = False
Exit Function
End If
If equal = "notcontain" Then
Forall r In entry.Roles
If r = chars Then
toaccess = False
Exit Function
End If
End Forall
toaccess = True
Exit Function
End If
Exit Function
End If
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If obj2 = "mutli-value" Then
' In mutli-value type, the equal parament only have two: contain / notcontain
If equal <> "contain" And equal <> "notcontain" Then
ReturnMsg("toaccess_parament_error")
Exit Function
End If
' ========================================Function Module 2 =============================================
If equal = "notcontain" Then
Forall r In obj1
If r = chars Then
toaccess = False
Exit Function
End If
End Forall
toaccess = True
Exit Function
End If
If equal = "contain" Then
Forall r In obj1
If r = chars Then
toaccess = True
Exit Function
End If
End Forall
toaccess = False
Exit Function
End If
Exit Function
End If
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If obj2 = "string" Then
' In string type, the equal parament only have two: contain / notcontain / = / <>
If equal <> "contain" And equal <> "notcontain" And equal <> "=" And equal <> "<>" Then
ReturnMsg("toaccess_parament_error")
Exit Function
End If
' ========================================Function Module 3 =============================================
If equal = "contain" Then
If Instr(obj1,chars) > 0 Then
toaccess = True
Exit Function
End If
End If
If equal = "notcontain" Then
If Instr(obj1,chars) = 0 Then
toaccess = True
Exit Fu
a38b
nction
End If
End If
If equal = "=" Then
If obj1 = chars Then
toaccess = True
Exit Function
End If
End If
If equal = "<>" Then
If obj1 <> chars Then
toaccess = True
Exit Function
End If
End If
toaccess = False
Exit Function
End If
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If obj2 = "number" Then
' In number type, the equal parament only have two: > / < / = / <>
If equal <> ">" And equal <> "<" And equal <> "=" And equal <> "<>" Then
ReturnMsg("toaccess_parament_error")
Exit Function
End If
' ========================================Function Module 4 =============================================
If equal = "<" Then
If Cint(obj1) < Cint(chars) Then
toaccess = True
Exit Function
End If
End If
If equal = ">" Then
If Cint(obj1) > Cint(chars) Then
toaccess = True
Exit Function
End If
End If
If equal = "=" Then
If Cint(obj1) = Cint(chars) Then
toaccess = True
Exit Function
End If
End If
If equal = "<>" Then
If Cint(obj1) <> Cint(chars) Then
toaccess = True
Exit Function
End If
End If
toaccess = False
Exit Function
End If
sl:
Msgbox "Error Message is : " & Error & Chr(13) & Chr(13) & "error line is : " & Erl
End Function
相关文章推荐
- 【原创】LS程序 - 判定文档在当前视图下是否唯一
- 当程序用ado的jet4.0方式连接的时候,对于设有access数据库密码的mdb的访问居然报错“无法启动应用程序,工作组信息文件丢失,或是已被其他用户已独占方式打开”,而用odbc方式不报错,小阴沟里翻船,郁闷中然后查文档解决之
- 当程序用ado的jet4.0方式连接的时候,对于设有access数据库密码的mdb的访问居然报错“无法启动应用程序,工作组信息文件丢失,或是已被其他用户已独占方式打开”,而用odbc方式不报错,小阴沟里翻船,郁闷中然后查文档解决之
- 当程序用ado的jet4.0方式连接的时候,对于设有access数据库密码的mdb的访问居然报错“无法启动应用程序,工作组信息文件丢失,或是已被其他用户已独占方式打开”,而用odbc方式不报错,小阴沟里翻船,郁闷中然后查文档解决之
- 对于类成员访问控制属性public和private的理解
- android 的从上到下的LED的控制程序(对于初学者或是有一定研究的人员 想了解android的系统机理值得一看)
- 如何在C程序中访问文本文档,并读取数据
- c# webbrowser与winform交互访问,javascript参数调用控制程序
- Process Monitor监测记录表明,QQ不仅会自动访问许多与聊天无关的程序和文档,例如“我的文档”等敏感位置,测试当天的上网记录也没能幸免。随后,QQ还会产生大量网络通讯,很可能是将数据上传到腾讯服务器。短短10分钟内,它访问的无关
- 单文档程序中动态控制多个窗体的切换
- [柴原创经验]asp之 地址栏参数传递 和 程序顺序控制
- 论并发程序控制与天通苑交通阻塞之关系(原创)
- 【原创】对于访问IIS元数据库失败的解决(续)
- 使用版本控制软件TortoiseSVN对程序和文档进行控制的说明
- 微信小程序 setData 的坑 原创 2017年01月01日 17:57:56 标签:微信小程序 30607 最近在使用微信小程序的setData时,遇到了以下问题。如下: 官网文档在使用setD
- 『原创』老范的XML文档编辑程序——不是一般的山寨!(原创附程序)
- [求助]带程序访问控制的防火墙 eTrust Personal Firewall 和卡巴斯基2009引起冲突造成系统频繁死机
- 第06章:包及访问控制权限帮助文档
- 程序控制过程机器级表示(访问条件码)-《深入理解计算机系统》笔记
- MFC 文档view视图中根据鼠标指定的某个区域控制延迟显示tip的方法(原创)