< html >

< head >

< title > Lync Custom Presence Editor </ title >

< HTA:APPLICATION

APPLICATIONNAME = "Lync Custom Presence Tool"

ID = "LyncCustomPresenceTool"

SCROLL = No

VERSION = "1.0"

MAXIMIZEBUTTON = "no"

/>

</ head >

< script language = "VBScript" >

Option Explicit

Dim wshshell, objfso, xmldoc

Dim profilepath, username, PresenceXML, PresenceREG, root

Set wshShell = CreateObject ( "WScript.Shell" )

Set objFso = CreateObject ( "Scripting.FileSystemObject" )

Set xmlDoc = CreateObject ( "Microsoft.XMLDOM" )

XMLDoc . setProperty "SelectionLanguage" , "XPath"

profilepath = wshShell . ExpandEnvironmentStrings ( "%userprofile%" )

username = wshShell . ExpandEnvironmentStrings ( "%username%" )

PresenceXML = profilepath & "\presence.xml"

PresenceREG = profilepath & "\CustomLyncPresence.reg"

Sub Window_OnLoad

Dim span, list, Checkbox, listbox, textbox, paragraph, root, readnode, availability, objOption, i

window . resizeto 450 , 260

Set span = document . getElementById ( "MainSpan" )

list = Array ( "Online" , "Busy" , "Do-Not-Disturb" )

For i = 1 To 4 'Yep, only four. Look it up.

Set Checkbox = document . createElement ( "input" ) 'This dynamically populates the inputs, except for the two buttons.

Checkbox . type = "Checkbox" 'Dynamically making those (with working onclick events) is hard, and using innerhtml is a cop-out!

Checkbox . id = "Status" & i & "Enable" 'Also, I hate using "with" for assigning less than 6 attributes. Deal with it!

Checkbox . name = "Status" & i & "Enable"

span . appendchild Checkbox

Set listbox = document . createElement ( "select" )

listbox . size = "1"

listbox . name = "Status" & i & "Type"

listbox . id = "Status" & i & "Type"

For Each availability In list

Set objoption = document . createElement ( "option" )

objoption . text = availability

objoption . value = availability

listbox . add objoption

Next

span . appendchild listbox

Set textbox = document . createElement ( "input" )

textbox . type = "text"

textbox . name = "Status" & i & "Text"

textbox . id = "Status" & i & "Text"

textbox . size = 40

span . appendchild textbox

Set paragraph = document . createElement ( "p" )

span . appendchild paragraph

Next

If objFso . fileexists ( PresenceXML ) Then

xmlDoc . Async = "False"

xmlDoc . Load ( PresenceXML )

Set root = xmlDoc . DocumentElement

For i = 1 To 4

Set readnode = root . selectsinglenode ( "customState[contains(@ID,'" & i & "')]" )

If Not readnode Is Nothing Then

populateform i,readnode . attributes . item ( 1 ) . value ,readnode . text

End If

Next

End If

End Sub

function OnClickButtonRemove ( )

RegControl "delete"

If objFso . fileexists ( PresenceXML ) Then objfso . deletefile ( PresenceXML )

If objFso . fileexists ( PresenceREG ) Then objfso . deletefile ( PresenceREG )

location . reload ( True )

MsgBox "Removed! Sign out and back in to see the changes."

End Function

sub OnClickButtonSet ( )

Dim Check, i

Check = 0

For i = 1 To 4

If document . getElementById ( "Status" & i & "Enable" ) . Checked = true Then Check = 1

Next

If Check = 0 Then

MsgBox "Nothing to do!"

Exit Sub

End If

RegControl ( "add" )

Set xmldoc = nothing

Set xmlDoc = CreateObject ( "Microsoft.XMLDOM" )

Set root = xmlDoc . createElement ( "customStates" )

xmlDoc . appendChild root

For i = 1 To 4

If document . getElementById ( "Status" & i & "Enable" ) . Checked = True Then

AddStatus i, document . getElementById ( "Status" & i & "Type" ) . value , document . getElementById ( "Status" & i & "Text" ) . value

End if

Next

xmlDoc . Save PresenceXML

MsgBox "Set! Sign out and back in to see the changes."

End Sub

Function AddStatus ( id, availability, text )

Dim objState, objActivity

Set objState = xmlDoc . createElement ( "customState" )

objState . SetAttribute "ID" , id

objState . SetAttribute "availability" ,availability

root . appendChild objState

Set objActivity = xmlDoc . createElement ( "activity" )

objActivity . Text = text

objActivity . SetAttribute "LCID" , "1033"

objState . appendChild objActivity

end function

Function populateform ( id, availability, text )

document . getElementById ( "Status" & id & "Enable" ) . Checked = True

document . getElementById ( "Status" & id & "Type" ) . value = availability

document . getElementById ( "Status" & id & "Text" ) . value = text

End Function

Function RegControl ( state )

Dim regfile, return

Set regFile = objfso . createTextfile ( PresenceREG, True )

return = wshshell . run ( "reg query HKCU\Software\Policies\Microsoft\Communicator /v EnableSipHighSecurityMode" , 7 , True )

If state = "add" Then

If return = 1 Then

regFile . writeline "Windows Registry Editor Version 5.00" & vbNewline & "[HKEY_CURRENT_USER\SOFTWARE\Policies\Microsoft\Communicator]" & vbNewline & "" "CustomStateURL" "=" "file:///c:/users/" & Username & "/presence.xml" "" & vbNewline & "" "EnableSIPHighSecurityMode" "=dword:00000000"

regFile . Close

wshShell . Run "regedit /s " & PresenceREG

End If

ElseIf state = "delete" Then

If return = 0 Then

regFile . writeline "Windows Registry Editor Version 5.00" & vbNewline & "[HKEY_CURRENT_USER\SOFTWARE\Policies\Microsoft\Communicator]" & vbNewline & "" "CustomStateURL" "=-" & vbNewline & "" "EnableSIPHighSecurityMode" "=-"

regFile . Close

wshShell . Run "regedit /s " & PresenceREG

End If

End if

End Function

</ script >

< body bgcolor = "white" >

< span ID = "mainspan" ></ span >

< input type = "button" name = "Set" ID = "Set" value = "Set" style = "height:25px; width=200px;" onclick = "onclickbuttonSet" >

< input type = "button" name = "Remove" ID = "Remove" value = "Remove" style = "height:25px; width=200px;" onclick = "onclickbuttonremove" >

</ body >