Comments (2)

By Scott, July 30, 2009 4:57 PM

This VBScript uses native SQL connectivity via ADO to query your BlackBerry Enterprise Server configuration database for the current number of users. Since the license total is not stored in the database you have to set it as a variable in the script. It then compare the two numbers and if your defined threshold is exceeded, it will email you a notification. Just schedule the script to run daily. Download a zipped version here, or copy below.

'BES license usage monitor.  Set current license total, alert threshold, And
'other variables to be notified when the license usage exceeds the threshold.
Dim strSQLServer, strBESDB, iCurrentLicenseTotal, iLicenseThreshold
Dim strMailRecipients, strMailSender, strMailSubject, strMailServer
'*************************************
'------Configurable Variables---------
iCurrentLicenseTotal = 1000 'Total number of licenses in License Management
iLicenseThreshold = 20 'Free licenses threshold for notification
strSQLServer = "ServerName" 'NetBIOS name of SQL Server
strBESDB = "DatabaseName" 'Database name in SQL
'------Notification configuration-----
strMailRecipients = "user1@domain.com,user2@domain.com" 'Command-separated list of addresses
strMailSender = "BESLicenseCounter@domain.com" 'From address
strMailSubject = "BES license usage at critical level" 'Subject of notification message
strMailServer = "smtpserver.domain.com" 'FQDN of smarthost
'*************************************

Dim iCurrentUserTotal, iAvailableLicenses, strSQLQuery, strSQLConn
Dim objSQLConn, objSQLRecordSet, objSQLExec
strSQLConn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Data Source=" & _
	strSQLServer & "; Initial Catalog=" & strBESDB
strSQLQuery = "Select Count(*) As Total_Users From UserStats"
Set objSQLConn = CreateObject("ADODB.Connection")
Set objSQLRecordSet = CreateObject("ADODB.Recordset")
objSQLConn.Open = strSQLConn
objSQLRecordSet.Open strSQLQuery, objSQLConn
Set objSQLExec = objSQLRecordSet
While Not objSQLExec.EOF
	iCurrentUserTotal = objSQLExec.Fields("Total_Users").Value
	objSQLExec.MoveNext
Wend
iAvailableLicenses = iCurrentLicenseTotal - iCurrentUserTotal
If iAvailableLicenses < iLicenseThreshold Then
	Dim strMailBody
	strMailBody = iCurrentUserTotal & " of " & iCurrentLicenseTotal & " licenses are in use."
	strMailBody = strMailBody & "  It is time to order more licenses."
	SendMail
End If

Sub SendMail
	Set objEmail = CreateObject("CDO.Message")
	objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strMailServer
	objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	objEmail.Configuration.Fields.Update
	objEmail.From = strMailSender
	objEmail.To = strMailRecipients
	objEmail.Subject = strMailSubject
	objEmail.HTMLBody = strMailBody
	objEmail.Send
End Sub

Comments (1)

By Scott, February 26, 2008 1:39 PM

If certain MAPI limits are reached when working with sessions, items, attachments, etc., Exchange will deny further access to that user to that object type.  When this happens event ID 9646 is logged in the Application log.  The description of the event contains a mailbox GUID that is causing the issue, but the GUID alone does nothing to indicate what user/mailbox is affected.

Microsoft KB 899663 instructs how to manually transpose GUID into a format that can be used in an LDAP filter so that you can search for a match.  Why do all this by hand when a script can do it for you?  I took an existing script I had that already does the transposition and added an AD search to return the matching dn.  The dn is passed to a name translation function that converts the dn to the NT4 format (domain\username) and displays the match with username and display name.

In addition to the VBScript file, I have also included a compiled version that uses SAPIEN Script Host as the engine.  This is a self-contained, runs-in-memory-only, no-DOS-box-comes-up engine from PrimalScript.  Running the compiled version is nice since you don’t have to ensure that CScript is the default host and no DOS box appears while the script is running.

The zip file with both versions is available here .

Comments (0)

By Scott, August 7, 2007 7:32 AM

I have automated DLs that use LDAP filters for membership criteria.  These filters are stored as binary data in the extensionData attribute of the group object, so they are not easily accessible by users who want to know what filter is being applied to a DL they own.

It was easy enough to extract the LDAP filter from the attribute, convert it to a string value, and display it.  But users don’t generally know how to read LDAP filters, let alone represented as a long line of text.  So I started looking for utilities or scripts that would take an LDAP filter, parse it, and display it with nesting.  Uh, yeah, there aren’t any.  I was determined, and so countless hours later I have a function that do such a thing.

The difficult part was keeping track of the level of nesting/indentation at any point. Since a filter can be written in almost any order as long as the resulting equation equals what you want, I couldn’t use any kind of static detection. Just because an open parentheses is following by another one doesn’t mean that you are, say, three levels nested. So the important part of the script keeps track of the indentation level as the cursor position moves through the filter.

I replace ampersands in the filter with crosshatches while working with it because I was having weird results otherwise, most likely because the ampersand is an operator in both LDAP and VBScript. And because the output is to an IE window and the indentation uses non-breaking spaces instead of the traditional tab (which doesn’t exist in HTML), I substitute the HTML string for a non-breaking space with a unique string of letters so the ampersand in that doesn’t get in the way.

Because this is part of a bigger script, I pulled out just the portion that formats the LDAP filter and displays it in an IE window. You just need to provide the "raw" filter, whether directly in the script or some other method. Copy and paste the code below or download it here.

Option Explicit
Dim strLDAPFilter, strFormattedFilter
Dim objIE, objDoc
strLDAPFilter = "YourLDAPFilter"
Set objIE =  CreateObject("InternetExplorer.Application")   objIE.AddressBar = False
objIE.Menubar = False
objIE.Toolbar = False
objIE.Resizable = True
objIE.Height = 450
objIE.Width = 700
objIE.Visible = True
objIE.Navigate("about:blank")
While objIE.Busy
	WScript.Sleep 100
Wend

Set objDoc = objIE.Document
objDoc.Open
objDoc.Write("<TITLE>LDAP Filter Display</TITLE>")
objDoc.Write("<BODY BGCOLOR=#C0C0C0>")

'Parse the LDAP filter and format results for display
'Apply nesting for readability
strFormattedFilter = FormatLDAPDisplay(strLDAPFilter)
objDoc.Write(strFormattedFilter)
'Format single-line LDAP filter to include nesting
Function FormatLDAPDisplay(strLDAPFilter)
	'Replace ampersands with crosshatches to keep them from interfering
	strLDAPFilter = Replace(strLDAPFilter, Chr(38), Chr(35))

	'Iterate through each character in filter and insert CRLF and nesting
	Dim intPos, intIndentCount, intWhileIndent
	Dim strIndentation, strInsert, strCharacter, strNewLDAPFilter
	Dim bolDblClose
	intPos = 1
	intIndentCount = 0
	Do While intPos < Len(strLDAPFilter)
		strCharacter = Mid(strLDAPFilter, intPos, 1)
		intWhileIndent = 1
		strIndentation = ""
		Select Case strCharacter
			'LDAP operators to watch for to modify nesting level.
			'NOT operator ignored because only used in one-off attribute value
			Case Chr(35), Chr(124)
				'Operator followed by open paren means nesting increase
				If Mid(strLDAPFilter, intPos + 1, 1) = Chr(40) Then
					intIndentCount = intIndentCount + 1
					'Build nest based on number of indentations
					Do While intWhileIndent <= intIndentCount
						'Use unique string as placeholder for nesting with HTML spaces
						strIndentation = strIndentation & "QZNBSPQZNBSPQZNBSPQZNBSP"
						intWhileIndent = intWhileIndent + 1
					Loop
					'Insert new string for formatting
					strNewLDAPFilter = Replace(strLDAPFilter, strCharacter, strCharacter & "<br>" & strIndentation, intPos, 1)
					'Restore full filter including new string
					strLDAPFilter = Left(strLDAPFilter, intPos - 1) & strNewLDAPFilter
					'Move current position to next character after inserted string
					intPos = intPos + Len(strIndentation) + 6
				Else
					intPos = intPos + 1
				End If
			Case Chr(40)
				Do While intWhileIndent <= intIndentCount
					strIndentation = "QZNBSPQZNBSPQZNBSPQZNBSP" & strIndentation
					intWhileIndent = intWhileIndent + 1
				Loop
				If Not strIndentation = "" Then
					'If open paren follows close paren, insert CRLF
					If Mid(strLDAPFilter, intPos - 1, 1) = Chr(41) Then
						strIndentation = strIndentation & "<br>"
					End If
					strNewLDAPFilter = Replace(strLDAPFilter, strCharacter, strIndentation & strCharacter, intPos, 1)
					strLDAPFilter = Left(strLDAPFilter, intPos - 1) & strNewLDAPFilter
					intPos = intPos + Len(strIndentation) +1
				Else
					intPos = intPos + 1
				End If
			Case Chr(41)
				'Two consecutive close paren means nesting reduces one level
				If Mid(strLDAPFilter, intPos + 1, 1) = Chr(41) Then
					intIndentCount = intIndentCount - 1
					bolDblClose = True
				End If
				Do While intWhileIndent <= intIndentCount
					strIndentation = strIndentation & "QZNBSPQZNBSPQZNBSPQZNBSP"
					intWhileIndent = intWhileIndent + 1
				Loop
				strNewLDAPFilter = Replace(strLDAPFilter, strCharacter, strCharacter & "<br>" & strIndentation, intPos, 1)
				strLDAPFilter = Left(strLDAPFilter, intPos - 1) & strNewLDAPFilter
				'Adjust position to account for two close paren
				If bolDblClose = True Then
					intPos = intPos + Len(strIndentation) + 5
					bolDblClose = Empty
				Else
					intPos = intPos + Len(strIndentation) + 6
				End If
			Case Else
				'No paren or operator means move to next character
				intPos = intPos + 1
		End Select
	Loop

	'Replace LDAP operators with words
	strLDAPFilter = Replace(strLDAPFilter, Chr(35), "<i>AND</i>")
	strLDAPFilter = Replace(strLDAPFilter, Chr(124), "<i>OR</i>")
	strLDAPFilter = Replace(strLDAPFilter, Chr(33), "<i>NOT </i>")
	'Replace spaceholders with HTML spaces
	strLDAPFilter = Replace(strLDAPFilter, "QZNBSP", Chr(38) & "nbsp;")
	FormatLDAPDisplay = strLDAPFilter
End Function

Set objIE = Nothing

Comments (0)

By Scott, July 30, 2007 11:52 AM

Since I am using approval for comments on my site, I had no way of knowing when someone posted a comment pending approval.  And since you can’t simply look for comments to posts without going into the database directly, I needed a way to know when someone has posted a comment and to which post it belongs.

To do this, add this subroutine to the end of functions.asp, which is the CDO code to send a message.  I didn’t use variables that are assigned in config.asp, so you will have to set them in the subroutine directly for SMTP server, from address, to address, and domain name in the body. 

<%
'Send comment notification
Sub SendEmail (strBDate, strBID)
	Dim objMail
	Set objMail = CreateObject("CDO.Message")
	objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing")      = 2
	objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver")     = "SMTP hostname"
	objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	objMail.Configuration.Fields.Update
	objMail.From     = "fromaddress@yourdomain.com"
	objMail.To       = "toaddress@yourdomain.com"
	objMail.Subject  = "Comment has been submitted for approval"   
	objMail.HTMLBody = "A comment has been submitted for approval.  Go to http://www.yourdomain.com/admin?cmd=bloglist&view=calendar&blogDate=" & strBDate & "&comments=" & strBID & " to approve."
	objMail.Send
	Set objMail = Nothing
End Sub
%>

Then you need to add code to functions.asp to call this subroutine from the subroutine that inserts the comment.  Find the subroutine labeled InsertComment(), which should be around line 475 depending on other mods of mine or your own that you may have inserted.  Right before the existing line: 

Response.Redirect("default.asp?view=plink&id=" & bID & "&comments=1")

insert this code:

' convert blog ID to blog Date
strSQL = "SELECT * FROM  T_WEBLOG WHERE id = " & bID & " ORDER BY id DESC"
Set Rs = Server.CreateObject("ADODB.Recordset")
Rs.ActiveConnection = strConn
Rs.Source = strSQL
Rs.CursorType = 0
Rs.CursorLocation = 2
Rs.LockType = 1
Rs.Open()

If Not rs.EOF Then
	rs.MoveFirst
	While Not rs.EOF
		strBDate = rs("b_date")
		rs.MoveNext
	Wend
End If

SendEmail strBDate, bID

This is necessary because the comments are not accessed by using the blog entry ID, but the blog entry’s date.  So it is necessary to cross-reference the entry ID to the entry date, and then link to the comments for a given entry ID on that date.  The last line calls the email function which will include a hyperlink to the comments for the blog entry that has a new comment.

Now, that is all fine and dandy.  You will receive the email with the link, but when you follow it to your site, you probably won’t have an active session so you will have to log in.  The way the admin default and login pages work, you will lose the link to the entry you need to approve so you have to click the link in the email again.  I work around this by implementing the use of query strings so the site remembers where you were trying to go before you had to log in.

To add this feature, edit admindefault.asp.  At line 8, replace the Response.Redirect line with the following code: 

Dim sProtocol, sDomain, sPath, sQuerystring, sResult
sProtocol = "http://"
If UCase(Request.ServerVariables("HTTPS")) = "ON" Then
	sProtocol = "https://"
	sDomain = LCase(Request.ServerVariables("SERVER_NAME"))
	sPath = LCase(Request.ServerVariables("SCRIPT_NAME"))
	sQuerystring = LCase(Request.Querystring)
	sResult = sProtocol & sDomain & sPath
	If Len(sQuerystring) > 0 Then
		sResult = sResult & "?" & sQuerystring
		sResult = Server.URLEncode(sResult)
		Response.Redirect("login.asp") & "?sURL=" & sResult

This builds a query string of the URL you were going to go to before you are redirected to the login page.  Now edit adminlogin.asp.  At line 34, before the If statement to check for a postback, insert the following line: 

strSourceURL = Request.QueryString("sURL")

This retrieves the query string and puts it into a variable.  At line 39, before the SQL statement to select the users from the database, insert the following code: 

If Not Trim(Request.Form("sourceURL")) = "" Then
	strSourceURL = Request.Form("sourceURL")
Else
	strSourceURL = "./?"
End If

This extra code is added to accommodate you entering a bad password or if you are logging in without following a comment link.  At line 74, comment out Johann’s Response.Redirect line after a successful login and then insert and replace the Response.Redirect for no user found with this: 

	Response.Redirect(strSourceURL)
Else
	Response.Redirect("login.asp?error=nouser") & "&sURL=" & Server.URLEncode(strSourceURL)

This sends you to the page you were intending to go to in the first place.  If you entered a bad password, this also preserves the original URL after the login page reloads.

Last, but not least, you need to a hidden form field that will store the original URL when you submit the form to log in.  Near the end of the file, insert a line before the close form tag and paste this: 

<input name="sourceURL" type="hidden" value="<%= strSourceURL %>" />

I hope that’s not too complicated to follow.  It’s a little more convoluted for this modification because it is necessary to add code in multiple places in multiple files, rather than just a chunk of code in one file.  But, now you will receive an email when a comment is posted and be easily able to approve or deny the comment just by following the link in the email.

Comments (0)

By Scott, July 22, 2007 4:01 PM

The first version of the script really was quick and dirty, requiring you to manually put the source and target users’ DNs in the script.  Since a coworker has been using the script, I thought it appropriate to update it to prompt for the usernames.  In addition, I added a new feature I recently read about, which is to output the results in real-time to a GUI.  This is done by creating an object for IE and writing the output similar to wscript.echo, but with the Write method of the object.

Like the original script, since we use automated DLs, too, I look for an indication that a given DL is a SmartDL and skip it.  And I now use PrimalScript to work with my scripts, so I use its packager to make an exectuable.  This makes it easier and nicer for non-IT end-users who will be running scripts like these.

Download it here, or copy/paste below.

'Version 2.0 - July 23, 2007
'Copy distribution group membership from one user to another,
'excluding automated DLs (SmartDL).
'Get source user
While Not bolExit = True
	strOldSamUser = InputBox("Enter the sAMAccountName of the person to copy DLs FROM." _
		, "Enter username")
	If strOldSamUser = "" Then
		WScript.Quit
	End If

	'Find the Global Catalog server
	Set objCont = GetObject("GC:")
	For Each objGC In objCont
		strADsPath = objGC.ADsPath
	Next

	Set objConnection = CreateObject("ADODB.Connection")
	Set objRecordset = CreateObject("ADODB.Recordset")
	objConnection.Provider = "ADsDSOObject"

	objConnection.Open "ADs Provider"
	strQuery = "<" & strADsPath & ">;(&(objectcategory=user)(sAMAccountName=" & strOldSamUser & _
		"));displayName,distinguishedName;subtree"
	Set objRecordset = objConnection.Execute(strQuery)

	If Trim(objRecordset.Fields("distinguishedName")) = "" Then
		strNoUser = MsgBox("Warning: User cannot be found.  Verify sAMAccountName.", vbCritical, "User not found!")
		bolExit = False
	Else
		intCorrectUser = MsgBox("Is this the correct user?" & VbCrLf & VbCrLf & "Display Name: " & _
		objRecordset.Fields("displayName") & VbCrLf & "DN: " & objRecordset.Fields("distinguishedName"), _
			vbYesNo, "Old user?")
		If intCorrectUser <> 6 Then
			bolExit = False
		Else
			strSrcDN = objRecordset.Fields("distinguishedName")
			bolExit = True
		End If
	End If
 Wend
'Open IE to display progress and results
Set objIE = CreateObject("InternetExplorer.Application")
objIE.AddressBar = False
objIE.Menubar = False
objIE.Toolbar = False
objIE.Resizable = True
objIE.Left = 10
objIE.Height = 450
objIE.Width = 800
objIE.Visible = True
objIE.Navigate("about:blank")
While objIE.Busy
	WScript.Sleep 100
Wend
Set objDoc = objIE.Document
objDoc.Open
objDoc.Write("<TITLE>Copy DL Membership</TITLE>")
objDoc.Write("<BODY BGCOLOR=#C0C0C0>")
objDoc.Write("<P><b>Source:</b> " & objRecordset.Fields("distinguishedName") & "<br>")
'Get target user
bolExit = False
While Not bolExit = True
	strNewSamUser = InputBox("Enter the sAMAccountName of the person to copy DLs TO." _
		, "Enter username")
	If strNewSamUser = "" Then
		objIE.Quit
		WScript.Quit
	End If
	strQuery = "<" & strADsPath & ">;(&(objectcategory=user)(sAMAccountName=" & strNewSamUser & _
		"));displayName,distinguishedName;subtree"
	Set objRecordset = objConnection.Execute(strQuery)
	If Trim(objRecordset.Fields("distinguishedName")) = "" Then
		strNoUser = MsgBox("Warning: User cannot be found.  Verify sAMAccountName.", vbCritical, "User not found!")
		bolExit = False
	Else
		intCorrectUser = MsgBox("Is this the correct user?" & VbCrLf & VbCrLf & "Display Name: " & _
			objRecordset.Fields("displayName") & VbCrLf & "DN: " & objRecordset.Fields("distinguishedName"), _
			vbYesNo, "Old user?")
		If intCorrectUser <> 6 Then
			bolExit = False
		Else
			Set objTargetUser = GetObject("LDAP://" & objRecordset.Fields("distinguishedName"))
			bolExit = True
		End If
	End If
 Wend
 'Write target user to IE window
 objDoc.Write("<b>Target:</b> " & objRecordset.Fields("distinguishedName") & "</P>")
 'Copy DLs
 strDomFQDN = Mid(strSrcDN, InStr(LCase(strSrcDN), ",dc=") + 4)
 strGCFQDN = Replace(LCase(strDomFQDN), ",dc=", ".")
 Set objOldUser = GetObject("GC://" & strGCFQDN & "/" & strSrcDN)
 For Each strGroup in objOldUser.MemberOf
	On Error Resume Next
	Set objGroup = GetObject("LDAP://" & strGroup)
	If Not Trim(objGroup.mailNickname) = "" Then
		If Not Instr(objGroup.info, "SmartDL") > 0 Then
			objGroup.Add(objTargetUser.ADsPath)
			If Err.Number = 0 Then
				objDoc.Write(objGroup.DisplayName & ": Update successful.<br>")
			Else
				objDoc.Write(objGroup.DisplayName & ": Update UNSUCCESSFUL.<br>")
			End If
		Else
			objDoc.Write(objGroup.DisplayName & ": Skipped (SmartDL).<br>")
		End If
	End If
	On Error Goto 0
 Next

 Set objOldUser = Nothing
 Set objTargetUser = Nothing
 Set objIE = Nothing
 Set objRecordset = Nothing
 Set objConnection = Nothing
 

Comments (0)

By Scott, July 21, 2007 9:34 PM

Johann almost added CAPTCHA verification to simpleblog 3, but he notes on his blog that he decided not to after looking at the pros and cons.  He says that simpleblog isn’t a target of comment spam because of the inability to post html or javascript code into a comment.  I disagree, however, because you still get targeted by comment spam by the very nature that bots will still post comments.  Even with approval enabled, I still have to delete the pending comments, and there can be A LOT of them.

Johann included a copy of Emir Tuzul’s free ASP CAPTCHA implementation, but never incorporated it into simpleblog.  I looked at how the code works and how Johann implemented comments, and I have successfully added CAPTCHA verification to the comments system.  Since doing so a few days ago, not a single spam comment has been left.  If you are interested, this is how to do it.

Since Johann included version 2 of the CAPTCHA code page, you do not need to download anything, but you can opt to use version 3 beta 1, which uses more character obfuscation to make it harder for bots to determine the characters in the image.

Edit functions.asp to add the following code to the end of the file, which is the verification function:

<%
Function CheckCAPTCHA(valCAPTCHA)
	SessionCAPTCHA = Trim(Session("CAPTCHA"))
	Session("CAPTCHA") = vbNullString
	If Len(SessionCAPTCHA) < 1 Then
		CheckCAPTCHA = False
		Exit Function
	End if
	If CStr(SessionCAPTCHA) = CStr(valCAPTCHA) Then
		CheckCAPTCHA = True
	Else
		CheckCAPTCHA = False
	End if
End Function
%>

Add the following code to functions.asp in the CommentsGet subroutine, which for me starts at line 351.  It may be different for you since I think I have added other code higher in the file.  This adds the actual CAPTCHA image to the comments form.  You will add this code after the call for GetEmoticons and the line break, which for me means inserting this at line 454:

Type the characters shown in the image for verification.
<img src="captcha.asp" alt="" width="86" height="21" />
<input name="strCAPTCHA" type="text" id="strCAPTCHA" maxlength="8" /></td>

At line 481 (after the declaration of the str_userIP variable), insert this, which puts the characters entered into the form in a variable:

strCAPTCHA = Trim(Request.Form("strCAPTCHA"))

Lastly, replace the code that inserts the comment into the database with the code below, starting at line 492 (after the comment  "insert Comment."  Instead of simply inserting the comment into the database, this will compare the entered characters to the actual ones in the image.  If they match, the comment is inserted.  If not, I use a JavaScript alert to present a popup box and then redirect the user back to the post:

If CheckCAPTCHA(strCAPTCHA) = True Then
	SQL = "INSERT INTO T_COMMENTS(c_content, c_name, c_email, c_url, c_bID_fk,ip) VALUES ('" & strComment & "','" & sanitize( strName ) & "','" & sanitize( strEmail ) & "','" &  sanitize( strUrl )& "'," &  sanitize( bID )& ",'"&str_userIP&"')"
	Set MyConn = Server.CreateObject("ADODB.Connection")
	MyConn.Open strConn
	MyConn.Execute(strSQL)
	MyConn.Close
	Set MyConn = Nothing
	Response.Redirect("default.asp?view=plink&id=" & bID & "&comments=1")
Else
	%>
	<script language="Javascript">
		alert('You did not type the verification code correctly.');
		location.replace('default.asp?view=plink&id=<%= bID %>&comments=1');
	</script>
	<%
End If

You’re done!  Save functions.asp and then go add a comment to one of your posts.  Intentionally enter incorrect characters to confirm the popup works and that the comment did not get added.  The only thing missing from this is that it doesn’t preserve the comment in the session.  This means that if a real person incorrectly enters the code, when returned to the post to try and enter another code, the actual comment data will have to be entered again.  Name, email, and URL don’t have to because they are stored in a cookie on the client.  Perhaps I will add that at a later time.

Comments (0)

By Scott, February 4, 2007 4:07 PM

Edit: The inline code in this post is not the latest version of the script. Get the latest version from the downloads page.

It is not uncommon at my company to have to move a user from one domain to another for technical, logistical, or political reasons.  For another set of reasons, moving the user account to the other domain is not done, instead manually creating a new one and associating the mailbox with the new account.

DL membership does not automatically get updated when this is done, so I have been doing it manually.  It has been on my to-do list for awhile to write a script to copy the DL membership from the old account to the new one.  So I threw this together this morning.  It lacks some of the nice extras my other scripts have (finding the user by logon name, email results, true logging) but it does work.

You have to edit the script to give it the variables for the old and new users’ dn.  It will skip security groups (any group without an alias) and also groups whose Notes (info) attribute contains the word SmartDL.  We use Imanami’s SmartDL for automated DL membership when applicable.  Those will be automatically updated the next time each of their jobs run.

Download it here, or copy/paste below.

Option Explicit
Dim strOldUser, strNewUser, objOldUser, objNewUser, strGroup, objGroup
strOldUser = "" 'dn of user to copy from'
strNewUser = "" 'dn of user to copy to'
Set objOldUser = GetObject("LDAP://" & strOldUser)
Set objNewUser = GetObject("LDAP://" & strNewUser)
wscript.echo "Source user: " & objOldUser.DisplayName
wscript.echo "Target user: " & objNewUser.DisplayName
For Each strGroup in objOldUser.MemberOf
	On Error Resume Next
	Set objGroup = GetObject("LDAP://" & strGroup)
    If Not Trim(objGroup.mailNickname) = "" Then
        If Not Instr(objGroup.info, "SmartDL") > 0 Then
			objGroup.Add(objNewUser.ADsPath)
			If Err.Num = 0 Then
				wscript.echo objGroup.DisplayName & ": Update successful."
			Else
				wscript.echo objGroup.DisplayName & ": Update UNSUCCESSFUL."
			End If
        Else
			wscript.echo objGroup.DisplayName & ": Skipped (SmartDL)."
        End If
	End If
	On Error Goto 0
Next
Set objOldUser = Nothing
Set objNewUser = Nothing

Comments (0)

By Scott, December 4, 2006 11:17 AM

I had previously posted (here) a script to create an email that reports the last full backup time of every database in the organization.  There wasn’t too much in the way of error correcting, so the script in my environment was failing to send anything when an Exchange server went offline recently (but is still in AD).

I have updated the script, which can be downloaded here, to not error when this happens and include if it is unable to connect to a specific server and read the last full backup time.  The HTML rendering didn’t look right for the server reported with an error, and I couldn’t figure out why, so also updated how the table is built.  Now the report is one big table instead of every server in its own table.

Comments (0)

By Scott, December 3, 2006 12:48 PM

I previously posted (here) a script to disable Exchange ActiveSync for unauthorized users.  The script is based on using the dn of one or more groups to determine authorized users (i.e., if you are in the group, you are allowed).  This method recently failed me (twice) because some of the groups were renamed by another admin to make them more readable.  Not only were the display names changed, but the objects were renamed as well, so the cn and dn were changed.  This means my script couldn’t find the groups I had hard-coded, which isn’t good scripting practice anyway.

I have updated the script, which can be downloaded here, to search for the groups based on their objectGUID, which never changes no matter what you do to the object (rename, move, etc.).  Instead of hard-coding the dn of the object, I hard-code the objectGUID.  Then I bind directly to the object based on the GUID to retrieve its dn, which is used in the search filter to find the users I want to modify.

Note that ADO allows you to bind to an object given just its GUID, without having to specify other connection parameters.  You can also use the hexadecimal or binary format of the GUID in the connection string; AD will figure out which format you are using. I used the binary format in my script so that I could just copy and paste the value from Hyena into my script without having to convert to a hex value.

Comments (2)

By Scott, June 21, 2006 4:49 PM

Our IT Leadership team decided that it will promote more effective collaboration if the Default calendar permission for all IT employees is set to Reviewer (instead of the Default of None). As with many of my scripts, I started with the work Glen Scales has already done. Go there for information on the prerequisite for using this script to make the change (the need for ACL.dll).

Glen’s script uses an input argument of a server name. My distributed environment doesn’t allow for such a broad application, so I use the membership of a DL that contains the IT personnel. This DL actually contains other DLs, so I separately use another script by Richard Mueller that enumerates nested groups and puts the results into a domain local group that is used for other purposes.

After getting the group members, I loop through each member for only those with a mailbox that isn’t hidden. For those who haven’t been touched by the script before, a function is called that uses CDO to log into the mailbox, enumerate the calendar permissions looking for the Default entry, and change it to Reviewer. The user’s local FreeBusy Data folder is also updated to set the Default to Editor since that permission goes hand in hand when setting permissions on the calendar.

To keep tabs on who the script has touched, a notation is added to extensionAttribute4 (customizable). Those with that notation are skipped in the future. Then an email is sent to the user informing them of the change. I chose to do this because Exchange users may be used to the fact the the Default permission is None; this way they are aware that their calendar is open for viewing. It also helps with new employees who are not aware of this "policy" and can mark items as Private as necessary.

Finally, an email is sent to the admin with the results of the job run. It includes the display name, mailbox server, and whether the permission was set or the object skipped (to catch entries that slip through my filter). I have scheduled this to run weekly, and I will get an email each time so I know that the script is successfully running and which users are being modified.

All of the variables that require customization are near the top. These are for mail configuration, search filter, and the notation parameters for touched mailboxes.

Download it here or copy below.

Option Explicit

Public Const CdoDefaultFolderCalendar = 0
Dim strSMTPServer, strMailFrom, strUserMailSubject, strUserMailBody
Dim strAdminMailRecip, strAdminMailSubject, strAdminMailBody
Dim strDefaultNamingContext, strQueryFilter, strAttName, strAttNote
Dim conn, com, iAdRootDSE, strNamingContext
Dim Rs, objGroup, strMember, objUser, strMsExchHomeServerName
Dim objSession, CdoInfoStore, CdoFolderRoot, ACLObj, CdoCalendar, FolderACEs, fldACE
Dim objRoot, objFreeBusyFolder

'Configuration parameters:
''''''''''''''''''''''''''''''''''''''''''''''
'Email notification configuration
strSMTPServer = "server.company.com" 'FQDN of SMTP server
strMailFrom = """Display Name"" <a href="mailto:SMTPAddress@company.com">SMTPAddress@company.com</a>" ' Display name and address of sender
strUserMailSubject = "The default permission on your calendar has been updated" 'Subject of message sent to users
strUserMailBody = "In order to promote effective collaboration among the Company " & _
    "employees, the Default permission on your calendar has been updated to Reviewer.  This allows anyone within the organization " & _
    "to see the details of items within your calendar.  For items that are of a sensitive, confidential, or personal nature, " & _
    "you can mark them as Private.  This will restrict the details of the item so that others cannot see the subject or body.  " & _
    "If you have any questions about this change, please reply to this message or contact the Help Desk at XXXX.<br><br>" & _
    "Company Messaging and Collaboration Team (GAL Display Name)<br>Department<br>Company" 'Body of message sent to users
strAdminMailRecip = "<a href="mailto:SMTPAddress@company.com">SMTPAddress@company.com</a>" 'Address of admin to receive status report
strAdminMailSubject = "Default calendar permission change report" 'Subject of message sent to admin
'Domain to search for object
strDefaultNamingContext = "dc=company,dc=com" 'AD FQDN of base scope to search
'Search filter for group with users
strQueryFilter = "(&(objectcategory=group)(displayName=something))" 'LDAP filter to locate group with members to modify

'Attribute and notation for updated objects
strAttName = "extensionAttribute4" 'defined for a single-valued string attribute
strAttNote = "DefaultCalSet" 'Notation used to skip processed users on future script runs
''''''''''''''''''''''''''''''''''''''''''''''
strAdminMailBody = ""
Set conn = createobject("ADODB.Connection")
Set com = createobject("ADODB.Command")
Set iAdRootDSE = GetObject("<a href="ldap://RootDSE">LDAP://RootDSE</a>")
strNamingContext = iAdRootDSE.Get("configurationNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
Com.ActiveConnection = Conn
com.Properties("Page Size") = 1000
Com.CommandText = "<GC://" & strDefaultNamingContext & ">;" & StrQueryFilter & ";distinguishedname;subtree"
Set Rs = Com.Execute
While Not Rs.EOF
	Set objGroup = GetObject("LDAP://" & Rs.fields("distinguishedname"))
	For each strMember in objGroup.Member
		Set objUser = GetObject("LDAP://" & strMember)
		If InStr(objUser.Get(strAttName), strAttNote) < 1 Then
			strAdminMailBody = strAdminMailBody & objUser.displayName & "<br>"
			If objUser.Class = "user" And Not IsNull(objUser.msExchHomeServerName) And Not UCase(objUser.msExchHidefromAddressLists) = "TRUE" Then
				strMsExchHomeServerName = objUser.msExchHomeServerName
				strMsExchHomeServerName = right(strMsExchHomeServerName,len(strMsExchHomeServerName)-instrrev(strMsExchHomeServerName,"/cn=")-3)
				strAdminMailBody = strAdminMailBody & "&nbsp;&nbsp;&nbsp;&nbsp;" & strMsExchHomeServerName & "<br>"
				Call dofreebusy(strMsExchHomeServerName, objUser.mailNickname)
				strAdminMailbody = strAdminMailBody & "&nbsp;&nbsp;&nbsp;&nbsp;Permission set on: " & objUser.mailNickname & "<br>"
				WriteTag
				SendEmail objUser.mail, strUserMailSubject, strUserMailBody
			Else
				strAdminMailBody = strAdminMailBody & "&nbsp;&nbsp;&nbsp;&nbsp;Skipping object<br>"
			End If
		End If
	Next
	Rs.MoveNext
Wend
Rs.Close

'Send admin email report
If Not strAdminMailBody = "" Then
	strAdminMailBody = strAdminMailBody & "<br>Done.<br>"
Else
	strAdminMailBody = "No mailboxes needed updating."
End If
SendEmail strAdminMailRecip, strAdminMailSubject, strAdminMailBody

Set conn = Nothing
Set com = Nothing

Function dofreebusy(serverName, mailboxName)
	'Set Default permission to Reviewer
	Set objSession = CreateObject("MAPI.Session")
	objSession.Logon "","",false,true,0,true,servername & vbLF & mailboxname
	Set CdoInfoStore = objSession.GetInfoStore
	Set CdoFolderRoot = CdoInfoStore.RootFolder
	Set ACLObj = CreateObject("MSExchange.aclobject")
	Set CdoCalendar = objSession.GetDefaultFolder(CdoDefaultFolderCalendar)
	ACLObj.CdoItem = CdoCalendar
	Set FolderACEs = ACLObj.ACEs
	For each fldACE in FolderACEs
		If fldACE.ID = "ID_ACL_DEFAULT" Then
			fldACE.Rights = 1025
			ACLObj.Update
		End If
	Next

	'Set local FreeBusy folder permission to Editor
	Set objRoot = objSession.GetFolder("")
	Set objFreeBusyFolder = objRoot.Folders.Item("FreeBusy Data")
	ACLObj.CdoItem = objFreeBusyFolder
	Set FolderACEs = ACLObj.ACEs
	For each fldACE in FolderACEs
		If fldACE.ID = "ID_ACL_DEFAULT" Then
		fldACE.Rights = 1123
		ACLObj.Update
		End If
	Next
End function

'Write notation tag into attribute
Sub WriteTag()
	If IsNull(objUser.Get(strAttName)) or IsEmpty(objUser.Get(strAttName)) Then
		objUser.Put strAttName, strAttNote & ";"
	Else
		Dim strExistAttName
		strExistAttName = objUser.Get(strAttName)
		objUser.Put strAttName, strExistAttName & strAttNote & ";"
	End If
	objUser.SetInfo
End Sub

'Send change notification and report
Sub SendEmail (strRecipAddress, strMailSubject, strMailBody)
	Dim objMail
	Set objMail = CreateObject("CDO.Message")
	objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
	objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	objMail.Configuration.Fields.Update

 objMail.From = strMailFrom
	objMail.To = strRecipAddress
	objMail.Subject = strMailSubject
	objMail.HTMLBody = strMailBody
	objMail.Send
	Set objMail = Nothing
End Sub