' Script um im MAPI-Profil die Auflösung neu anzutriggern.

Function ReadRegBinaryAsHex(regKey)
	Set Shell = CreateObject("WScript.Shell")
	regValue = Shell.RegRead(regKey)
	if uBound(regValue) <> 15 Then
		wscript.echo "Error reading Value für RegKey" & regKey : wscript.quit
	end if
	Dim strTemp : strTemp = ""

	For I = LBound(regValue) To uBound(regValue)
		if regValue(I) = 0 then
			strTemp = strTemp +hex(regValue(I))
		elseif regValue(I) < 16 then
			strTemp = strTemp + "0" + hex(regValue(I))
		else
			strTemp = strTemp +hex(regValue(I))
		end if
	Next

	ReadRegBinaryAsHex = strTemp
End Function


'--------------------------------------------------------------------------------
Function EnumerateHKCU(regKey)
' Source: http://www.winserverkb.com/Uwe/Forum.aspx/exchange-clients/8651/Update-display-name-of-additional-mailbox-after-name-change
	const HKEY_CURRENT_User = &H80000001
	strComputer = "."
	Set StdOut = WScript.StdOut
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
	oReg.EnumKey HKEY_CURRENT_User, regKey, arrSubKeys
	EnumerateHKCU = arrSubKeys
End Function

'--------------------------------------------------------------------------------

dim link1, link2, exprofile

Set Shell = CreateObject("WScript.Shell")

For Each outlookProfile In EnumerateHKCU("Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles")
	on error resume next
	wscript.echo "----------------- Processing OutlookProfile:" & outlookProfile
	link1 = ReadRegBinaryAsHex("HKEY_CURRENT_User\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & outlookProfile & "\9207f3e0a3b11019908b08002b2a56c2\01023d02")
	wscript.echo "Link1 is "& link1
	link2 = ReadRegBinaryAsHex("HKEY_CURRENT_User\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & outlookProfile & "\" & link1 & "\01023d15")
	wscript.echo "Link2 is "& link2
	exprofile = "HKEY_CURRENT_User\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\" & outlookProfile & "\"&link2
	'wscript.echo "ExProfile is "& exprofile
	wscript.echo "001e6603:" & Shell.RegRead(exprofile & "\" & "001e6603")
	wscript.echo "001e6612:" & Shell.RegRead(exprofile & "\" & "001e6612")
	wscript.echo "001e6750:" & Shell.RegRead(exprofile & "\" & "001e6750")
	wscript.echo "001f3001:" & Shell.RegRead(exprofile & "\" & "001f3001")
	if Err.Number <>0 then wscript.echo "  unable to remove all regkeys"
	Err.Clear : On Error Goto 0

	If WScript.Arguments.Named.Exists("write")  then
		if lcase(Wscript.Arguments.Named("profil")) ="" Then
			wscript.echo "Changes: DELETE ENTRY für ALL profiles"
			on error resume next
			Shell.RegDelete(exprofile & "\" & "001e6603")
			Shell.RegDelete(exprofile & "\" & "001e6612")
			Shell.RegDelete(exprofile & "\" & "001e6613")
			Shell.RegDelete(exprofile & "\" & "001f3001")
			if Err.Number <>0 then wscript.echo "  unable to remove all regkeys"
			Err.Clear : On Error Goto 0
		else
			if lcase(Wscript.Arguments.Named("profil")) = lcase(outlookProfile) then
				wscript.echo "Changes: DELETE ENTRY für given profile:" & outlookProfile
				on error resume next
				Shell.RegDelete(exprofile & "\" & "001e6603")
				Shell.RegDelete(exprofile & "\" & "001e6612")
				Shell.RegDelete(exprofile & "\" & "001e6613")
				Shell.RegDelete(exprofile & "\" & "001f3001")
				if Err.Number <>0 then wscript.echo "  unable to remove all regkeys"
				Err.Clear : On Error Goto 0
			else
				wscript.echo "Changes: Skip Profile:" & outlookProfile
			end if
		end if
	else
		wscript.echo "Changes: No WRITE Detected"
	end if
Next

wscript.echo "Done"