Monday, November 15, 2010

Password change reminder script for all AD

If you have remote users in your domain, they are not notified by the DC when their password is about to expire, because they open their windows session before the VPN client can connect to the DC.

Here is a script that you can run daily on your DC to send an email to users from an OU, everyday for some days before it expires.
So they know they have to change it before it really expires.

Option Explicit


' Per environment constants - you should change these

Const SMTP_SERVER = "emailserv.mydomain.intra"               ' your mail server

Const STRFROM = "dcserv@mydomain.intra"               ' your DC

Const DAYS_FOR_EMAIL = 14                          'Send notification when pwd will expire in this number of days

Const GROUPDN = "CN=USERS_OU,OU=Groups,OU=Domain Users,DC=mydomain,DC=intra"     ' Recurse this user OU

Const LOGFILE = "C:\Scripts\PasswordExpiration\passwordexpiration.log"     ' Log file path


' System Constants - do not change

Const ONE_HUNDRED_NANOSECOND = .000000100 ' .000000100 is equal to 10^-7

Const SECONDS_IN_DAY = 86400

Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000

Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D


' Change to "True" for extensive debugging output

Const bDebug = False


Dim numDays, iResult

Dim strDomain

Dim objGroup, objMember, member

Dim objFSO, objFile, strOutput


Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(LOGFILE) = True Then

     objFSO.DeleteFile(LOGFILE)

End If


Set objFile = objFSO.OpenTextFile(LOGFILE, 8, True)


Set objGroup = GetObject("LDAP://" & GROUPDN)

objFile.WriteLine "Executed at " & Now() & vbCRLF

objFile.WriteLine "Enumerating members of " & objGroup.distinguishedName & ":" & vbCRLF




Call GetSubMembers(objGroup)


objFile.WriteLine "Done. Finished at " & Now() & "."

objFile.Close


 


Function GetSubMembers (GroupObject)

Dim TmpMember

numDays = 0


If (TypeName(GroupObject.Member) = "Empty") Then

Exit Function

End If


If (TypeName(GroupObject.Member) = "String") Then

     TmpMember = GroupObject.Member

     Set objMember = GetObject("LDAP://" & GroupObject.Member)

     If (LCase(objMember.Class) = "user") then

      Wscript.Echo objMember.sAMAccountName

strDomain = Mid(objMember.distinguishedname, InStr(objMember.distinguishedname, "DC="))

      numdays = GetMaximumPasswordAge (strDomain)

objFile.WriteLine objMember.sAMAccountName & " " & TmpMember & " " & numdays & " " & objMember.Mail

Call ProcessUser (numDays)

     else

      Wscript.Echo "Group : " & objMember.CN

objFile.WriteLine "Group 1: " & objMember.CN

      Call GetSubMembers(objMember)

     End If



Else

For Each TmpMember In GroupObject.Member

      Set objMember = GetObject("LDAP://" & TmpMember)


If (LCase(objMember.Class) = "group") Then

      Wscript.Echo "Group : " & objMember.CN

objFile.WriteLine "Group 2: " & objMember.CN

Call GetSubMembers(objMember)

Else

      Wscript.Echo objMember.sAMAccountName

strDomain = Mid(objMember.distinguishedname, InStr(objMember.distinguishedname, "DC="))

      numdays = GetMaximumPasswordAge (strDomain)

objFile.WriteLine objMember.sAMAccountName & " " & TmpMember & " " & numdays & " " & objMember.Mail

Call ProcessUser (numDays)

End If

Next

End If

End Function




Function GetMaximumPasswordAge (ByVal strDomainDN)

     Dim objDomain, objMaxPwdAge

     Dim dblMaxPwdNano, dblMaxPwdSecs, dblMaxPwdDays


     Set objDomain = GetObject("LDAP://" & strDomainDN)

     Set objMaxPWdAge = objDomain.maxPwdAge


     If objMaxPwdAge.LowPart = 0 And objMaxPwdAge.Highpart = 0 Then

          ' Maximum password age is set to 0 in the domain

          ' Therefore, passwords do not expire

          GetMaximumPasswordAge = 0

     Else

          dblMaxPwdNano = Abs (objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)

          dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND

          dblMaxPwdDays = Int (dblMaxPwdSecs / SECONDS_IN_DAY)

          GetMaximumPasswordAge = dblMaxPwdDays

     End If

End Function




Function UserIsExpired (objMember, iMaxAge, iDaysForEmail, iRes)

     Dim intUserAccountControl, dtmValue, intTimeInterval

     Dim strName

     On Error Resume Next

     Err.Clear

     strName = Mid (objMember.Name, 4)

     intUserAccountControl = objMember.Get ("userAccountControl")


     If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then

          dp "The password for " & strName & " does not expire."

          UserIsExpired = False

     Else

          iRes = 0

          dtmValue = objMember.PasswordLastChanged

          If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then

               UserIsExpired = True

               dp "The password for " & strName & " has never been set."

          Else

               intTimeInterval = Int (Now - dtmValue)

               dp "The password for " & strName & " was last set on " & _

               DateValue(dtmValue) & " at " & TimeValue(dtmValue) & _

               " (" & intTimeInterval & " days ago)"

               If intTimeInterval >= iMaxAge Then

                    dp "The password for " & strName & " has expired."

                    UserIsExpired = True

               Else

                    iRes = Int ((dtmValue + iMaxAge) - Now)

                    dp "The password for " & strName & " will expire on " & _

                    DateValue(dtmValue + iMaxAge) & " (" & _

                    iRes & " days from today)."

                    If iRes <= iDaysForEmail Then

                         dp strName & " needs an email for password change"

                         UserIsExpired = True

                    Else

                         dp strName & " does not need an email for password change"

                         'Swap commented variable below to force email to be sent (for testing).

                         UserIsExpired = False

                    End If

               End If

          End If

     End If

End Function




Sub ProcessUser (iMaxPwdAge)

     Dim iResult, strExpire

     If Right (objMember.Name, 1) <> "$" Then

          If IsEmpty (objMember.Mail) or IsNull (objMember.Mail) Then

               dp Mid (objMember.Name, 4) & " has no mailbox"

          Else

               If UserIsExpired (objMember, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then

                    objFile.WriteLine "Sending an email to " & objMember.givenName & " " & objMember.sn & _

                         " (" & objMember.Mail & "). Password expires in " & iResult & " days." & vbCRLF

                    Call SendEmail (iResult)

               Else

                    If iResult = "" Then

                         strExpire = "."

                    Else

                         strExpire = " for " & iResult & " days."

                    End If

                    objFile.WriteLine "Skipping " & objMember.givenName & " " & objMember.sn & _

                         ". Password does not expire" & strExpire & vbCRLF

               End If

          End If

     End If

End Sub




Sub SendEmail (iResult)

     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_SERVER

     objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

     objMail.Configuration.Fields.Update


     objMail.From = STRFROM

     objMail.To = objMember.Mail


     objMail.Subject = "[IMPORTANT] :: The Windows password of " & Mid (objMember.Name, 4) & " is going to expire"

     objMail.Textbody = "Hello, The Windows Active Directory password for user " & objMember.givenName & " " & objMember.sn & _

" (" & objMember.sAMAccountName & ")" & " will expire in " & iResult & " days. " & vbCRLF & vbCRLF & _

"Please change it before it expires (CTRL+ALT+DEL, then change password)." & vbCRLF & vbCRLF & _

"If you are a remote user, please connect with your VPN client and then change the password (so that DC server will be notified). The VPN peer will be automatically updated within 5 minutes." & vbCRLF & _

"You can also use Outlook Web Access with Internet Explorer (richer GUI than in Firefox) from outside to change it before it expires." & vbCRLF & vbCRLF & _

"If you have a phone with email capability, please change your password on it too." & vbCRLF & vbCRLF & _

"Thank you."

     objMail.Send

     Set objMail = Nothing

End Sub




Sub dp (str)

     If bDebug Then

          objFile.WriteLine str

     End If

End Sub

MBR / GPT partition style and Windows Server 2008 R2 system partition

GPT partition style has been introduced to expand the limitations of the MBR (2TB).

Today with disks of 2TB, you can have a raid system much larger than 2TB (eg : on a NAS, file server…)

If you wish to install a system on a 8TB partition for instance you need to create a partition on a GPT partition style of 8TB.

Windows can handle disks larger than 2TB, but not for the windows system installation…
Even Windows Server 2008R2 can only install on a MBR partition style, so up to a 2TB partition.

So you will have to split your raid into 2 and have Windows installed on the first and have data on the second.

For instance :

We have 5x 2TB HDD (initially a 8GB raid 5)

It can become :

2x 2TB HDD (raid 1) for Windows

3x 2TB HDD (raid 5) for data

So there is a lot of spare space on the first partition (system). Of course you can split into 2 partitions (system + data).

So you’d better have 2 small disks in raid 1 for the system and then have multiple large disks for data.

Be aware that NAS servers are usually sold with a bunch of large disks.

Thursday, November 4, 2010

SharePoint 2010 not crawling some sites

I recently came across an issue where SharePoint was not indexing some Site Collections and the crawl logs were showing the following with reference to the problematic Site Collection:

"The SharePoint item being crawled returned an error when attempting to download the item"

It turns out the start page of the root site contained a search result webpart which was causing the crawler to abort the rest of the crawl.

This issue has since been fixed in a hotfix. Install the latest CU to solve the issue.

Wednesday, November 3, 2010

Central Management of Content Types with SharePoint 2010

A new feature of SharePoint 2010 allows you to publish your content types from one central hub to Site Collections that choose to subscribe to them.

The first thing you need to do is to to define the location of your hub. You will find this in the properties of the managed metadata service at the bottom:

image

Then in the properties of the managed metadata service connection you need to tell it to “consume content types from the content type gallery”:

image

The site collections that are then supposed to use the content type hub will need to activate the site collection feature “Content Type Syndication Hub”.

In order for content types to be published you need to change the setting under “Manage Publishing for this Content Type”