Posts tagged: inline code

Load balance new mailbox creation across multiple databases and servers using PowerShell

By Scott, May 27, 2009 2:42 PM

I needed a way to have new mailboxes be automatically distributed across a list of databases on multiple servers, and I recalled seeing a script somewhere.  The blog post with those details can be found here.  As the author points out, it can take a long time to build the hash table, too long for my requirements.  For example, one of my longer queries builds the table for 9 databases with over 5000 mailboxes in 58 seconds.  That is just way too  long for someone to feed a user account into to get a mailbox created.

So I broke down the query being used to find where efficiency could be improved.  The Get-ExchangeServer cmdlet slows the script down and can be avoided altogether by feeding the server list directly into the Get-MailboxDatabase cmdlet.  Additionally, I discovered just how inefficient the Exchange cmdlets are.  I already knew they were based on running other cmdlets for targets servers across a WAN that return not a lot of data, but this reinforced those findings.

To get away from the Exchange cmdlets, I query AD directly by instantiating ADSI in .NET manually.  Instead of slowly building the hash table I just take the record count of the search results and populate the table entry at once.  This reduced the time to completion from 58 seconds to 24 seconds.  These findings are consistent across different database counts and mailbox totals: 60% reduction in time.  While still too long for my taste, it certainly is much better than before and is within reason for the people at my company that make use of the script.

Since my script encompasses more than just the load balancing part (I create a GUI form where the location for the mailbox is selected, which feeds a list of appropriate servers to the function), this is just the part that creates the hash table with the database counts and returns the database with the lowest count:

$mbxServers = @()
$mailboxcount = @{}
$domain = [System.DirectoryServices.ActiveDirectory.Domain]::GetCurrentDomain()
$root = [ADSI]"GC://$($domain.Name)"
$mbxServers | %{Get-MailboxDatabase -server $_} | ?{$_.recovery -eq $FALSE} | %{
$filter = "(&(objectcategory=user)(homeMDB=" + ($_.DistinguishedName) + "))"
$search = new-Object System.DirectoryServices.DirectorySearcher($root,$filter)
$search.PropertiesToLoad.Add("homeMDB") | Out-Null
$result = $search.FindAll()
$mailboxcount["$($_.Identity)"] = $result.count
}
($mailboxcount.GetEnumerator() | sort value | select -first 1).key

PowerShell script to report last successful full backup of Exchange 2007

By Scott, July 22, 2008 7:28 AM

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

This script is a port of my original backup report that was written in VBScript.  That script reports on both 2003 and 2007 servers, but lacked some of the features that I wanted to put in.  PowerShell natively supports date-awareness, which makes it much easier to add the number one feature I wanted to add: highlighting servers that haven’t had backups since a specified period of time.

Because I am using the native Exchange cmdlets instead of WMI or CDOEXM, this only reports on Exchange 2007 servers.  I figure accommodating both is more work than it is worth, so I just modified my VBScript version to not include any server in the Exchange 12 admin group and I have both run every day until my migration to 2007 is complete.

The script reports the last successful full backup of any Exchange 2007 server with the mailbox role installed.  It checks for the presence of storage groups and databases within them.  It notes if a backup is currently in progress, as well as if a backup has never completed.  If a backup has not completed in the last 72 hours (modifiable), it is highlighted in red so it is easy to spot.  If a backup is less than the defined number of hours old, I use the Marlett font to display a green checkmark.  This allows for a checkmark without having to reference an external image or embed one.  Lastly, the report is emailed.  The script is shown below, but you can also just download it.

#Last Backup Report for Exchange 2007 servers
#Version 1.0 - 7/9/08
#--------------------------------------------

#Begin customization-------------------------
$SmtpServer = "server.domain.com" #Enter FQDN of SMTP server
$SmtpFrom = "Exchange Backups <exchangebackupreport@domain.com>" #Enter sender email address
$SmtpTo = "user1@domain.com","user2@domain.com" #Enter one or more recipient addresses in an array
$SmtpSubject = "Exchange 2007 Last Backup Report" #Enter subject of message
$iNomHours = "72" #Enter number of hours since last backup that requires attention
#End customization---------------------------

$date = Get-Date
$sSpace = "&nbsp;&nbsp;&nbsp;&nbsp;"
$sOutput = "<table>"

#Checkmark to indicate last backup within nominal time
$sCheckMark = "<span style=""font-family: Marlett; color: green; font-size: 14pt; font-weight: bold"">a</span>"

#Retrieve Exchange servers with mailbox role
$ExServer = Get-ExchangeServer | where {$_.IsMailboxServer -eq $True} | Sort-Object Name
Foreach ($server in $ExServer)
	{
	$sOutput += "<tr><td><font size=2><u><b>$server</b></u></font></td><td></td></tr>"
	#Retrieve storage groups for a given server
	$StorageGroup = $server | Get-StorageGroup | Sort-Object Name
	#Check for absence of any storage groups
	If (($StorageGroup | Measure-Object Name).Count -eq $null)
		{
		$sOutput += "<tr><td><font size=2>" + $sSpace + "No storage groups present.</font></td></tr>"
		}
	Else
		{
		Foreach ($sg in $StorageGroup)
			{
			$sOutput += "<tr><td><font size=2>" + $sSpace + $sg.Name + "</font></td></tr>"
			#Retrieve mailbox databases for a given storage group
			$MailboxDatabase = $StorageGroup | Get-MailboxDatabase -Status | Sort-Object Name
			#Check for absence of any databases in storage group
			If (($MailboxDatabase | Measure-Object Name).Count -eq $null)
				{
				$sOutput += "<tr><td><font size=2>" + $sSpace + $sSpace + "No mailbox stores present.</font></td></tr>"				}
			Else
				{
				Foreach ($db in $MailboxDatabase)
					{
					$sBackupRunning = ""
					#Note if backup is currently running
					If ($db.BackupInProgress -eq $true)
						{$sBackupRunning = "<font size=2 color=blue>(Backup In Progress)</font>"}
					#Determine if backup has ever completed
					If ($db.LastFullBackup -ne $null)
						{
						$sBackupDay = $db.LastFullBackup.get_DayofWeek()
						$sBackupDateTime = $db.LastFullBackup.ToString("g")
						#Flag if last completed backup started longer than defined variable
						If (($date - $db.LastFullBackup).TotalHours -gt $iNomHours)
							{
							$sLastBackup = "<font size=2>Last Backup Started At: <font color=red>" + $sBackupDay + ", " + $sBackupDateTime + "</font></font>"
							}
						Else
							{
							$sLastBackup = "<font size=2>Last Backup Started At: " + $sBackupDay + ", " + $sBackupDateTime + " </font>" + $sCheckmark
							}
						}
					Else
						{
						$sLastBackup = "<font size=2>No full backup has completed yet.</font>"
						}
					$sOutput += "<tr><td><font size=2>" + $sSpace + $sSpace + $db.Name + " </font></td><td>" + $sLastBackup + $sBackupRunning + "</td></tr>"
					}
				}
			}
		}
	}
$sOutput += "</table>"

#Email results
$SmtpClient = New-Object System.Net.Mail.SmtpClient
$MailMessage = New-Object System.Net.Mail.MailMessage
$SmtpClient.Host = $SmtpServer
$MailMessage.From = $SmtpFrom
Foreach ($address in $smtpTo)
	{$MailMessage.To.Add($address)}
$MailMessage.Subject = $SmtpSubject
$MailMessage.IsBodyHTML = $true
$MailMessage.Body = $sOutput
$SmtpClient.Send($MailMessage)

Script to format an LDAP filter for readability

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

Add comment notification to simplebog 3.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.

Updated: Copy DLs from one user to another

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
 

How to add CAPTCHA to simpleblog 3.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.

Quick and dirty script to copy DLs from one user to another

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

Change users’ default calendar permission (and email the users and admin)

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

Script to disable Exchange ActiveSync for unauthorized users

By Scott, June 1, 2006 9:09 AM

By default, users have all mobile services enabled (OMA, EAS including AUTD/DP).  This is a pain in my environment because only authorized users are allowed to use EAS (to ensure only approved devices procured through proper channels are used).  OMA, being similar to OWA, is allowed for everyone.

I had written a batch file long ago to change the bitmask attribute for users whose mobile services are enabled for everything (0) and are not in the appropriate DL of authorized users to disable only EAS (5).  It was an inefficient script that required explicit permissions for each domain, called a command-line regex tool to format the ldifde export, and was prone to errors.

This updated script accomplishes the same thing, but more efficiently.  It processes all users at one time (inside a for loop) and uses implicit permissions.  It even emails the results of the number of users modified.  The script is customized for my environment, but you can tweak it as necessary. 

I have five user domains, but the DLs for authorization are in one domain.  I wanted it to be as dynamic as possible, but balancing that with all the extra code necessary to make every piece not rely on hard-coded information.  So you need to provide mail config information, the NetBIOS domain names you want to loop through, and the dn of the groups for each user domain.  The GC to search and the DC to make the change to will be determined automatically.

Download it here or copy below.

Option Explicit

Dim mailFrom, mailTo, mailSubject, mailBody, mailServer
Dim objConnection, objCommand, objRecordSet, objUser, objGC, objDomain
Dim strGCPath, strNBDomain, strdomain, arrDomains, strCount
dim strSearchFilter, strEASDL, strDomainPath
strCount = ""

'Mail config
mailFrom = Wscript.ScriptName & "@company.com"
mailTo = "user@company.com"
mailSubject = "EAS Disable Results"
mailBody = ""
mailServer = "server.company.com"

'AD connection parameters
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

'Get FQDN of a GC
Set objGC = GetObject("GC://RootDSE")
strGCPath = objGC.Get("dnsHostName")

'Query each domain and call disable subroutine
arrDomains = array("domainA", "domainB", "domainC", "domainD", "domainE")
For each strDomain in arrDomains
	subOMADisable strdomain
Next

'Email results
Call subSendMail(mailFrom, mailTo, mailSubject, strCount, mailServer)

'Sub to change attribute value
Sub subOMADisable(strNBDomain)
	'Get base DN of domain
	Set objDomain = GetObject("LDAP://" & strNBDomain & "/RootDSE")
	strDomainPath = objDomain.Get("DefaultNamingContext")
	Set objDomain = Nothing

	Select Case strNBDomain
		Case "domainA"
			strEASDL = "dn of groupA"
		Case "domainB"
			strEASDL = "dn of groupB"
		Case "domainC"
			strEASDL = "dn of groupC"
		Case "domainD"
			strEASDL = "dn of groupD"
		Case "domainE"
			strEASDL = "dn of groupE"
	End Select
	strSearchFilter="(&(objectcategory=user)(mailnickname=*)(homeMDB=*)(!memberof=" & strEASDL & ")(!msExchOMAAdminWirelessEnable=5))"
	objCommand.CommandText = "<GC://" & strGCPath & "/" & strDomainPath & ">;" & strSearchFilter & ";distinguishedname;subtree"
	Set objRecordSet = objCommand.Execute
	If objRecordSet.RecordCount > 0 Then
		While Not objRecordSet.EOF
			Set objUser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedname"))
			'wscript.echo objUser.DisplayName
			objUser.Put "msExchOMAAdminWirelessEnable", "5"
			objUser.SetInfo
			objRecordSet.MoveNext
		Wend
	End If
	strCount = strCount & vbTAB & strNBDomain & ": " & objRecordSet.RecordCount & vbCRLF
End Sub

'Sub to send email with results
Sub subSendMail (mFrom, mTo, mSubject, mBody, mServer)
	Dim objEmail
	Set objEmail = CreateObject("CDO.Message")
	objEmail.From = mFrom
	objEmail.To = mTo
	objEmail.Subject = mSubject
	objEmail.Textbody = "Objects modified in each domain:" & vbCRLF &vbCRLF & mBody
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mServer
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	objEmail.Configuration.Fields.Update
	objEmail.Send
End Sub

'Cleanup
Set objUser = Nothing
Set objCommand = Nothing
Set objGC = Nothing
Set objConnection = Nothing

Company name change and email addresses

By Scott, May 1, 2006 1:14 PM

My company changed its name a couple weeks ago and so I needed to add a new primary address for those who had the old domain as a primary, and move the old primary to a secondary. I was surprised that I couldn’t hardly find any existing scripts to accommodate such an endeavor so I had to resort to doing it myself.

This script goes through all accounts in a given AD domain and whose primary email address is the "old" SMTP domain name, makes the primary a secondary, takes the username portion of the address and appends the new domain and makes it the new primary. I log all of the old address and new addresses to the screen, so redirect the output to a file to capture that. It doesn’t check for preexisting addresses so conflicts can occur. I had previously done my own extract to look for those, so dealing with them manually was easier and faster than coding for that.

I modified the script each time I ran it to change the AD domain I wanted to search (though I could have just defined an array of domain names and looped through each of them), and ran it against DLs and public folders, too, adjusting the filter to return the different object types. You will need to do the same.

Download the code here, or copy below.

Option Explicit
'Set value for domain to run against and LDAP filter to use
'Also set the old and new SMTP domain names on line 33
'If you need to update the display name to remove a company designation, that is line 80
dim strDomain, strSearchFilter
strdomain = "nbdomain" 'Put the NetBIOS domain name here
'Update filter below to return the object types you want, e.g., users, groups, publicfolders
strSearchFilter = "(&(objectcategory=publicfolder)(mailnickname=*)(mail=*@olddomain.com))" 

'Connect to AD
Dim objConnection, objCommand, objRecordSet, objUser
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 10000

'Retrieve user objects
Const ADS_PROPERTY_UPDATE = 2
objCommand.CommandText = "<LDAP://" & strDomain & ">; " & strSearchFilter & "; distinguishedname"
Set objRecordSet = objCommand.Execute
wscript.echo "Count:" & objRecordSet.RecordCount
While not objRecordSet.EOF
	Set objUser = GetObject("LDAP://" & Replace(objRecordSet.Fields("distinguishedname"),"/", "\/"))
	wscript.echo objUser.displayName & "; " & strDomain & "\" & objUser.sAMAccountName

	'Set values for new email addresses
	Dim blnExists, strNewMail, i, strOldProxy, strAddress
	Dim arrProxyAddresses, intProxyAddresses, strNewProxy, intProxyForLoop
	arrProxyAddresses = objUser.proxyAddresses
	intProxyAddresses = UBound(arrProxyAddresses)
	intProxyForLoop = intProxyAddresses	

	'Set value for mail
	strNewMail = Replace(objUser.mail, "@olddomain.com", "@newdomain.com")
	wscript.echo vbTab & "Old mail: " & objUser.mail
	wscript.echo vbTab & "New mail: " & strNewMail
	wscript.echo ""

	'Log old SMTP proxies
	For each strOldProxy in arrProxyAddresses
		If UCase(Left(strOldProxy,5)) = "SMTP:" Then
			wscript.echo vbTab & "Old proxies: " & strOldProxy
		End If
	Next

	'Change primary to secondary and add new primary
	blnExists = False
	For i = 0 to intProxyForLoop
		dim strAddressType, strAddressBody
		strAddressType = Left(arrProxyAddresses(i),5)
		strAddressBody = Mid(arrProxyAddresses(i),6)
		If UCase(strAddressType) = "SMTP:" Then
			If strAddressType = "SMTP:" Then
	    			arrProxyAddresses(i) = Replace(arrProxyAddresses(i), "SMTP:", "smtp:")
	    		Else
	    			If LCase(strAddressBody) = LCase(strNewMail) Then
					blnExists = True
					arrProxyAddresses(i) = Replace(arrProxyAddresses(i), "smtp:", "SMTP:")
				End If
			End If
		End If
		If i = intProxyForLoop Then
			If Not blnExists Then
				ReDim Preserve arrProxyAddresses(intProxyAddresses + 1)
				arrProxyAddresses(intProxyAddresses + 1) = "SMTP:" & strNewMail
			End If
		End If
	Next

	'Log new SMTP proxies
	For each strNewProxy in arrProxyAddresses
		If UCase(Left(strNewProxy,5)) = "SMTP:" Then
			wscript.echo vbTab & "New proxies: " & strNewProxy
		End If
	Next
	wscript.echo ""

	'Remove component designation from display name
	Dim strDisplayName
	strDisplayName = Replace(objUser.displayName, " - COMPANY", "")
	wscript.echo vbTab & "New display: " & strDisplayName

	'Commit changes
	objUser.Put "mail", strNewMail
	objUser.PutEx ADS_PROPERTY_UPDATE, "proxyAddresses", arrProxyAddresses
	objUser.Put "displayName", strDisplayName
	On Error Resume Next
	objUser.SetInfo
	If Err.Number <> 0 Then
		wscript.echo "Update unsuccessful!"
	Else
		wscript.echo "Update successful"
	End If
	wscript.echo vbCRLF
	On Error Goto 0
	objRecordSet.MoveNext
Wend

Set objRecordSet = Nothing
Set objUser = Nothing
Set objCommand = Nothing
Set objConnection = Nothing

Panorama Theme by Themocracy