Solved

Outlook Redemption to view Calendar Permissions

Posted on 2010-09-17
2
725 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
ID: 33703328
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
ID: 33719139
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

Active Directory Webinar

We all know we need to protect and secure our privileges, but where to start? Join Experts Exchange and ManageEngine on Tuesday, April 11, 2017 10:00 AM PDT to learn how to track and secure privileged users in Active Directory.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Finding original email is quite difficult due to their duplicates. From this article, you will come to know why multiple duplicates of same emails appear and how to delete duplicate emails from Outlook securely and instantly while vital emails remai…
How to resolve IMCEAEX NDRs in Exchange or Exchange Online related to invalid X500 addresses.
This video discusses moving either the default database or any database to a new volume.
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

820 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