update the AD description of the computer instead of local

'The LDAP root where we want to start our OU enumeration from.
'
' i.e.: ou=domain workstations,dc=contoso,dc=com
sRoot = "ou=domain workstations,dc=contoso,dc=com"

ImportDomains(sRoot)

Sub ImportDomains(sRoot)
On Error Resume Next

Set WshShell = CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("PROCESS")

'Set registry key so the HTA can run without causing any weird ADO exceptions.
WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\1406", 0, "REG_DWORD"

Set objADInfo = CreateObject("ADSystemInfo")
Set objComputer = GetObject("LDAP://" & objADInfo.ComputerName)
If sRoot = "" then
Set objRootDSE = GetObject("LDAP://rootDSE")
strSchema = "LDAP://" & objRootDSE.Get("schemaNamingContext")
'msgbox "ADsPath to schema: " & strSchema
aSchema = split(replace(strSchema,"LDAP://",""),",")

For i = 0 to ubound(aSchema)

If instr(aSchema(i),"CN=") Then
'msgbox "processing: " & aSchema(i)
strSchema = replace(strSchema,aSchema(i) & ",","")
End If
Next

'msgbox "sRoot " & strSchema
Set objDomain = GetObject(ucase(strSchema))
Else
If left(ucase(sRoot),7) <> "LDAP://" then
sRoot = "LDAP://" & sRoot
End If

Set objDomain = GetObject(ucase(sRoot))
End If

'Get distinguished name of computer for use later.
strComputerDN = objADInfo.ComputerName

'Get plain-jane computer name
sComputer = WshSysEnv("computername")
computer_OU = replace(objComputer.Parent,"LDAP://","")

'update a couple html elements with our new information.
document.getElementByID("spnComputerName").value = sComputer
document.getElementByID("spnDescription").value = GetDescription(sComputer)
document.getElementbyID("spnCurrentOU").innerhtml = computer_OU

'Populate our list with OU's from the root
Call EnumOUs(objDomain, "")
on error goto 0
setOptionByValue document.getElementByID("optOUs"),computer_OU
on error resume next

objRecordSet.Close
objConnection.Close

End Sub 'ImportDomains

Function ExitApp(var)
If var = "force" then
sResult = 6
Else
'Prompt user to make sure they want to exit.
sResult = Msgbox ("Are you sure you want to quit?",36,"Quit application?")
End If

'If response is 'yes', then close.
If sResult = 6 then
window.close()
End If

End Function 'ExitApp

Sub OUChange(sValue)
sProposedOU = sValue
if sProposedOU <> computer_OU and sProposedOU <> "" then bChangeOU = true

'Update HTML element with values of our newly selected OU and
' unhide our submit button to make the changes.
document.getelementbyid("spnStatus").innerhtml = sValue

bUpdateOU = true
End Sub 'OUChange

Sub ChangesMade(sVar)
If document.getElementByID("spnComputerName").value <> sComputer then
bUpdateComputer = true
bChangesMade = true
else
bUpdateComputer = false
End If
If document.getElementByID("spnDescription").value <> GetDescription(sComputer) then
bUpdateDescription = true
bChangesMade = true
Else
bUpdateDescription = false
End If

If sProposedOU <> computer_OU and sProposedOU <> "" then
bChangeOU = true
bChangesMade = true
Else
bChangeOU = false
End If

if bChangeOU = false and bUpdateDescription = false and bUpdateComputer = false then bChangesMade = false

If bChangesMade = true then
document.getElementByID("btnSubmit").style.display = "inline"
document.getelementbyid("btnFakeSubmit").style.display = "none"
Else
document.getElementByID("btnSubmit").style.display = "none"
document.getelementbyid("btnFakeSubmit").style.display = "inline"
End If
End Sub 'ChangesMade

Sub setOptionByValue(objSelect, myvalue)

'If this computer is not in an OU, then don't generate an error.
if instr(lcase(myvalue),"cn=") then

Else
for i = 0 to objSelect.options.length
on error resume next
if objSelect.options(i).value = myValue then
objSelect.options(i).selected = true

Exit for
End if
next
End If

If err.number <> 0 then


sResult = msgbox ("Could not preselect the OU structure. This error often occurs if the computer was renamed without rebooting, or communication to the domain could not be established." & vbcrlf & vbcrlf & "Would you like to reboot now?",36,"Error while enumerating OU")

If sResult = 6 then
On Error goto 0
Set objWMIService = GetObject("winmgmts:{(Shutdown)}\\.\root\cimv2")
Set colComputers = objWMIService.ExecQuery("Select * From Win32_OperatingSystem")
For Each objSystem in colComputers
objSystem.Reboot
Next
End If

document.getElementByID("spnComputerName").disabled = true
document.getElementByID("optOUs").disabled = true

End If
End Sub 'setOptionByValue

Sub ConfirmMove(sValue)
on error resume next
Dim sMsg
if bUpdateComputer = true then sMsg = "Changing computer name from '" & sComputer & "' to '" & trim(document.getElementByID("spnComputerName").value) & "'" & vbcrlf & vbcrlf
if bUpdateDescription = true then sMsg = sMsg & "Changing computer description to '" & trim(document.getElementByID("spnDescription").value) & "'" & vbcrlf & vbcrlf
'msgbox sProposedOU & vbcrlf & computer_OU
if bChangeOU = true then sMsg = sMsg & "Moving computer to the following OU: " & vbcrlf & vbcrlf & sValue
'Prompt user with yes/no messagebox to confirm move.
sResult = Msgbox (sMsg,36,"Confirm actions?")

'If response is 'yes', then make the OU move, prompt user with a message and then
' refresh the HTA.
If sResult = 6 then

If bChangeOU = true then
Set objNewOU = GetObject("LDAP://" & sValue)
Set objMoveComputer = objNewOU.MoveHere("LDAP://" & strComputerDN, "CN=" & sComputer)
msgbox "OU move submitted. Clicking OK will refresh this window.",64,"Request submitted"
If err.number <> 0 then
msgbox "There was an error while trying to move this computer to the OU you " _
& "selected. Please check your permissions or contact your system " _
& "administrator.",48,"An error occured."
End If
End If
SetDetails trim(document.getElementByID("spnComputerName").value),trim(document.getElementByID("spnDescription").value)
Location.Reload(True)

End If
End Sub 'ConfirmMOve

Sub EnumOUs(objParent, strOffset)
On Error Resume Next
' Recursive subroutine to enumerate OU's.
objParent.Filter = Array("organizationalUnit")

If Not objParent.OU="" Then
Set objOption = Document.createElement("Option")
objOption.Text = strOffSet & objParent.OU
objOption.Value = objParent.Distinguishedname
DomainList.Add objOption
End If

For Each objChild In objParent
'Call this recursive subroutine and add a blank string of
' characters to give the illusion of nested OU's in the
' listbox.
Call EnumOUs(objChild, strOffset & " ")
Next
End Sub 'EnumOus

Function GetDescription(sComputer)
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colComputers = objWMIService.ExecQuery ("Select Description from Win32_OperatingSystem")

For Each objComputer in colComputers
strDescription = objComputer.Description
Next

GetDescription = strDescription

End Function 'GetComputerDetails

Sub SetDetails(strNewComputerName,strNewDescription)
'msgbox strNewDescription
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colComputers = objWMIService.ExecQuery ("Select Name from Win32_ComputerSystem")

For Each objComputer in colComputers
If objComputer.Name <> strNewComputerName Then
'rename this computer
intErrorCode = objComputer.Rename(strNewComputerName)
//msgbox interrorcode
If intErrorCode <> 0 then
msgbox "There was an error while renaming this computer (" & sComputer & ") to '" & strNewComputerName & "'",48,"Could not rename computer"
ElseIf intErrorCode = 5 then
msgbox "You do not have sufficient permissions to rename this computer. Please log in as an administrator and try again.",48,"Could not rename computer."
ElseIf intErrorCode = 0 then
bDontRefresh = true
sResult = msgbox("Computer renamed successfully. You must restart the computer as soon as possible to make changes effective on the domain. Would you like to do so now?" & vbcrlf & vbcrlf & "Clicking 'No' will close the utility.",36,"Reboot?")

If sResult = 6 then
On Error goto 0
Set objWMIService = GetObject("winmgmts:{(Shutdown)}\\.\root\cimv2")
Set colComputers = objWMIService.ExecQuery("Select * From Win32_OperatingSystem")
For Each objSystem in colComputers
objSystem.Reboot
Next
End If
ExitApp("force")
End If
End If
Next

Set colComputers = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
For Each objComputer in colComputers
'Update the description for this computer
objComputer.Description = strNewDescription
intErrorCode = objComputer.Put_
Next
If intErrorCode <> 0 then
msgbox "There was an error while updating the description to '" & strNewDescription & "'",48,"Could not update description"
End If
End Sub 'RenameComputer