Solved

Outlook Redemption to view Calendar Permissions

Posted on 2010-09-17
2
720 Views
Last Modified: 2012-05-10
I recently stumbled across Outlook Redemption and its dll.  From what I have been reading there should be a way to utilize Outlook Redemption to determine what permissions a user has set on Outlook items such as calendar, contacts etc.

I need to know if there is a way to do it and if so; how?
0
Comment
Question by:LouSch7
2 Comments
 
LVL 26

Assisted Solution

by:e_aravind
e_aravind earned 500 total points
Comment Utility
http://www.outlookcode.com/article.aspx?id=52
redemption
Outlook Redemption provides a COM interface to Outlook objects that avoids the "object model guard" and exposes properties and methods not available through the Outlook model, such as sender address, the RTF body of an item, Internet message headers, MAPI tables, and many more. Several security features protect it from being used by malicious programs to send Outlook mail. Redemption is free for personal use. The redistributable developer version adds a Profman.dll component with the ability to enumerate, add, delete, and modify Outlook profiles using VB or VBScript.


Outlook Redemption Frequently Asked Questions
http://www.dimastr.com/redemption/faq.htm
0
 
LVL 3

Accepted Solution

by:
LouSch7 earned 0 total points
Comment Utility
It may not be the prettiest of things however, I was able to write a solution that did what I needed in the end.

For anyone else's reference the code is provided below; there are two main portions to it:
1) Outlook delegates
2) Calendar Permissions.
'*******************************************
					'*******************************************
					'START DELEGATE INFORMATION SCRIPTS
					'*******************************************
					'*******************************************
					ntUserName = RSSelectedClient("ClientEmail")							
				
					Set objRootDES = GetObject("LDAP://rootDSE")
					strADSPath = "LDAP://" & objRootDES.Get("defaultNamingContext")
				
					Set objCommand = CreateObject("ADODB.Command")
					Set objConn = CreateObject("ADODB.Connection")
				
					objConn.Open "Provider=ADsDSOObject;"
				
					Set objCommand.ActiveConnection = ObjConn
				
					objCommand.CommandText = "SELECT publicDelegates FROM "+"'"+strADsPath+"'"+" WHERE mail = "+"'"+ntUserName+"'"+" AND objectCategory = 'Person'"
				
					objCommand.Properties("SearchScope") = 2
					objCommand.Properties("Page Size") = 1000
				
					Set objRecordSet = objCommand.Execute
					
					
					pDelegate = objRecordSet("publicDelegates")	
					
					If isArray(pDelegate) Then
						If uBound(pDelegate) > 0 Then
							Response.Write "<tr>"
								Response.Write "<td colspan=" & """" & "2" & """" & ">"
									Response.Write "<b><em>User has delegates assigned:</em></b><br>"
									For i=0 to UBound(pDelegate)
										Set objCommand2 = CreateObject("ADODB.Command")
										Set objCommand2.ActiveConnection = ObjConn
										objCommand2.CommandText = "SELECT userAccountControl,distinguishedName,name,mail FROM "+"'"+strADsPath+"'"+" WHERE distinguishedName = "+"'"+pDelegate(i)+"'"+" AND objectCategory = 'Person'"
										
										Set objRecordSet2 = objCommand2.Execute				
										
										Set objUser = GetObject("LDAP://" & objRecordSet2("distinguishedName"))						
											strUser = ""
																	
											If inStr(objRecordSet2("distinguishedName"),"Termed") Then
												strUser = strUser & "<span style=" & """" & "color:maroon; font-weight:bold;" & """" & ">"
													strUser = strUser & objRecordSet2("name") & " </span><em>- Termed</em>"
											Else
												strUser = strUser & objRecordSet2("name")
											End If							
											If objUser.AccountDisabled <> FALSE Then
												strUser = strUser & " Account Disabled"
											End If
											
											Response.Write strUser & "<br/>"
										Set objRecordSet2 = Nothing			
									Next
								Response.Write "</td>"
							Response.Write "</tr>"
						End If
					End If
					'*******************************************
					'*******************************************
					'END DELEGATE INFORMATION SCRIPTS
					'*******************************************
					'*******************************************
					
					
					
					'*******************************************
					'*******************************************
					'START CALENDAR PERMISSIONS INFORMATION SCRIPTS
					'*******************************************
					'*******************************************
					
					On Error Resume Next
					If RSSelectedClient("ClientEmail") Then
						Dim CalendarRights, userDelegate
						Dim strProfileInfo
							
						strServer = "myserver"
						strMailbox = Trim(Left(RSSelectedClient("ClientEmail"),(inStr(RSSelectedClient("ClientEmail"),"@")-1)))						
						
						Const ForReading = 1
						Const ForAppending = 8
						
						Const  RIGHTS_EDIT_OWN = &h8
						Const  RIGHTS_EDIT_ALL = &h20
						Const  RIGHTS_DELETE_OWN = &h10
						Const  RIGHTS_DELETE_ALL = &h40
						Const  RIGHTS_READ_ITEMS = &h1
						Const  RIGHTS_CREATE_ITEMS = &h2
						Const  RIGHTS_CREATE_SUBFOLDERS = &h80
						Const  RIGHTS_FOLDER_OWNER = &h100
						Const  RIGHTS_FOLDER_CONTACT = &h200
						Const  RIGHTS_FOLDER_VISIBLE = &h400
						Const  RIGHTS_NONE = 0
						Const  ROLE_OWNER = &h5e3
						Const  ROLE_PUBLISH_EDITOR = &h4e3
						Const  ROLE_EDITOR = &h463
						Const  ROLE_PUBLISH_AUTHOR = &h49b
						Const  ROLE_AUTHOR = &h41b
						Const  ROLE_NONEDITING_AUTHOR = &h413
						Const  ROLE_REVIEWER = &h401
						Const  ROLE_CONTRIBUTOR = &h402
						Const  ROLE_NONE = &h400
						
						Const CdoDefaultFolderCalendar = 0	
						Const UDefault = "ID_ACL_DEFAULT"
						Const UAnonymous = "ID_ACL_ANONYMOUS"
						
						
						Set objACLObject = CreateObject("MSExchange.ACLObject")
						
						Set objSession = CreateObject("MAPI.Session") 
						
						strProfileInfo = strServer & vbLf & strMailbox 
						
						objSession.Logon , , False, True, , True, strProfileInfo 
						
						'Get the Default Information store and Calendar Folder
						Set objStore = objSession.GetInfoStore("") 
						Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderCalendar)
						objACLObject.CDOItem = objFolder
						
						Set objACEs = objACLObject.ACEs
						Set objACEs2 = objACLObject.ACEs
						
						userAceCount = 0
						For Each userAce in objACEs2
						
							Select Case userAce.ID
								Case UDefault
									userDelegate = "UDefault"
								Case UAnonymous
									userDelegate = "UAnonymous"
								Case Else
									Set TempEntry = objSession.GetAddressEntry(userAce.ID)
									userDelegate = UCase(TempEntry.Name)
							End Select
						
							Select Case userAce.Rights
								case "0"
									CalendarRights = "none"
								case "2043"
									CalendarRights = "OWNER"
								case "1179"
									CalendarRights = "PUBLISHING AUTHOR"
								case "1147"
									CalendarRights = "EDITOR"
								case "1025"
									CalendarRights = "REVIEWER"
								case "1275"
									CalendarRights = "Publishing Editor"
								case "1051"
									CalendarRights = "Author - 1051"
								case "1563"
									CalendarRights = "Author + Folder Contact - 1563"
								Case "1024"
									CalendarRights = "Folder Visible - 1024"
								Case "1026"
									CalendarRights = "CONTRIBUTOR"
								Case "1043"
									CalendarRights = "NONEDITING_AUTHOR - 1043"
								case "1923"
									CalendarRights = "Custom - All Check Boxes - 1923"
								case "1067"
									CalendarRights = "Custom - Create,Read,Visible + Edit:all,Del:none - 1067"
								case "1035"
									CalendarRights = "Custom - Create,Read,Visible + Edit:own,Del:none - 1035"
								Case else
									CalendarRights = "??custom?? - " & userAce.Rights
							End Select
							
							strDelegate = format_ucase(lcase(userDelegate))
								If inStr(strDelegate ,"Udefault") Then strDelegate = "" Else strDelegate = strDelegate End If
								If inStr(strDelegate ,"Uanonymous") Then strDelegate = "" Else strDelegate = strDelegate End If
							
							strRights = format_ucase(lcase(CalendarRights))
							
							
							strText = format_ucase(lcase(userDelegate)) & " - " & format_ucase(lcase(CalendarRights)) & "<br/>"
							If inStr(strText,"Udefault") Then 
								strText = "" 
								userAceCount = userAceCount - 1
							Else 
								strText = strText 
							End If
							If inStr(strText,"Uanonymous") Then 
								strText = "" 
								userAceCount = userAceCount - 1
							Else 
								strText = strText 
							End If
							finalText = finalText & strText
							userAceCount = userAceCount + 1
						Next
						If Len(finalText) < 10 Then userAceCount = 0 End If
						If userAceCount > 0 Then
							Response.Write "<tr>"
								Response.Write "<td colspan=" & """" & "2" & """" & ">"
									Response.Write "<b><em>User has additional Calendar Permissions set:</em></b><br>"									
									Response.Write finalText
								Response.Write "</td>"
							Response.Write "</tr>"
						End If						
					End If
					'*******************************************
					'*******************************************
					'END CALENDAR PERMISSIONS INFORMATION SCRIPTS
					'*******************************************
					'*******************************************

Open in new window

0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Exchange server is not supported in any cloud-hosted platform (other than Azure with Azure Premium Storage).
Following basic email etiquette rules will help you write a professional email and achieve a good, lasting impression with your contacts.
To show how to generate a certificate request in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.:  First we need to log into the Exchange Admin Center. Navigate to the Servers >> Certificates…
how to add IIS SMTP to handle application/Scanner relays into office 365.

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now