'==========================================================================
'
' NAME: ClearHomeDirectory.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: [URL unfurl="true"]http://www.thespidersparlor.com[/URL]
' DATE : 12/11/2006
' COPYRIGHT (C) 2006 The Spiders's Parlor
'
' COMMENT: Removes legacy homeDrive and homeDirectory profile settings from AD.
'
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF
' ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED To
' THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
' PARTICULAR PURPOSE.
'
' IN NO EVENT SHALL THE SPIDER'S PARLOR AND/OR ITS RESPECTIVE SUPPLIERS
' BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
' DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
' WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
' ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
' OF THIS CODE OR INFORMATION.
'==========================================================================
On Error Resume Next
Dim WSHShell,WSHProcess
Const ADS_PROPERTY_CLEAR = 1
'This section will find the logon server
Set WSHShell = CreateObject("Wscript.Shell")
Set WSHProcess = WSHShell.Environment("Process")
DomainLogonServer = WSHProcess("LogonServer")
'Now we will query user accounts on the logon server
strComputer = Right(DomainLogonServer,Len(DomainLogonServer)-2)
'WScript.Echo strComputer
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_UserAccount",,48)
'Now we enumerate through the users, find the distinguishedName and clear the home directory
For Each objItem In colItems
userName = objItem.Name
userDN = SearchDistinguishedName(userName)
'Bind to the user object & clear the home directory settings
Set objUser = GetObject("LDAP://" & userDN)
objUser.PutEx ADS_PROPERTY_CLEAR, "homeDirectory", 0
objUser.PutEx ADS_PROPERTY_CLEAR, "homeDrive", 0
objUser.SetInfo
Set objUser=Nothing
Err.Clear
Next
Public Function SearchDistinguishedName(ByVal vSAN)
' Function: SearchDistinguishedName
' Description: Searches the DistinguishedName for a given SamAccountName
' Parameters: ByVal vSAN - The SamAccountName to search
' Returns: The DistinguishedName Name
Dim oRootDSE, oConnection, oCommand, oRecordSet
Set oRootDSE = GetObject("LDAP://rootDSE")
Set oConnection = CreateObject("ADODB.Connection")
oConnection.Open "Provider=ADsDSOObject;"
Set oCommand = CreateObject("ADODB.Command")
oCommand.ActiveConnection = oConnection
oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & _
">;(&(objectCategory=User)(samAccountName=" & vSAN & "));distinguishedName;subtree"
Set oRecordSet = oCommand.Execute
On Error Resume Next
SearchDistinguishedName = oRecordSet.Fields("DistinguishedName")
On Error GoTo 0
oConnection.Close
Set oRecordSet = Nothing
Set oCommand = Nothing
Set oConnection = Nothing
Set oRootDSE = Nothing
End Function