lunes, agosto 15, 2011

Borrando una configuracion IMAP del perfil de Outlook

El desafio era, agregamos el perfil de exchange, pero como sacamos el perfil anterior??

Aca les dejo el script que contruimos, falta depurarlo, seguro se puede hacer en menos lineas, jejjee.

Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_CURRENT_USER = &H80000001


Set Ws = WScript.CreateObject("WScript.Shell")


Dim ww


set ww=wscript.createobject("wscript.network")


nombreusu=ww.UserName
avalor = Array(1,1,1,1,1,1)
strComputer = "."
KeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\"
DefaultProfile="vacio"


On Error Resume Next
DefaultProfile = ws.RegRead("HKCU\" & KeyPath & "DefaultProfile")
If DefaultProfile = "vacio" Then
WScript.quit


End if


Call BuscaKey()


WScript.Quit


Sub BuscaKey()
'----------------------


Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676"


oReg.EnumKey HKEY_CURRENT_USER,strKeyPath, arrSubKeys


For Each subkey In arrSubKeys
WScript.Echo subkey


If eslakey(subkey) Then
aborrar = strKeyPath & "\" & subkey
oReg.DeleteKey HKEY_CURRENT_USER, aborrar


End if
Next


End sub






Private Function eslakey(subkey)
'-------------------------------


Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676\" & subkey


oReg.EnumValues HKEY_CURRENT_USER,strKeyPath, arrValueNames


For Each Valor In arrValueNames


If Valor = "IMAP Server" Then
imapserver = 1
End If


Next


eslakey = 0


if imapserver = 1 Then


strValueName = "IMAP Server"
oReg.GetBinaryValue HKEY_CURRENT_USER, strKeyPath, strValueName,strValue
imapsrv=strValue


email= ""


For i = lBound(strValue) to uBound(strValue)
If strvalue(i) <> 0 Then
email=email + Chr(strValue(i))
End If


Next


If LCase(email) = "mailserver.dominio.cl" or LCase(email) = "10.10.10.11" Then
eslakey = 1
End if


End If
End function


WScript.Quit

Saludos!

Isa

1 comentario:

juegos ipad dijo...

Gracias por la información. Saludos