Notificación de password para owa
Hace un tiempo un cliente que tiene mucha gente por owa sin acceso a la red me pidio si le podia armar algo para que les avise de manera evidente que se les esta por vencer el password ya que los usuarios se quejaban que no notaban el cartelito del owa. Asi que arme este script que manda un mail a cada usuario que tiene el password cerca de caducar, Espero les sea util Solo hay que renombrarlo a .vbs, cambiar los parametros de smtp, tiempo de control para el envio del mail y ejecutarlo con cscript.
'------copiar---
'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.1
'
' NAME: Notificacion de cambio de passoword para exchange
'
' AUTHOR: Leandro Amore.
' DATE : 7/14/2007
'
' COMMENT: El script chequea la antiguedad del password de cada usuario en AD
' y envia un mail informando que debe ser cambiado si se cumple una condicion.
'==========================================================================
'defino constantes para el sistema
Const SMTP_SERVER = "192.168.0.2"
Const STRFROM = "administrador@prisma.cc"
Const DAYS_FOR_EMAIL = 35
'Constantes de sistema, no modificar
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const bDebug = True 'amplia o reduce la informacion mostrada en pantalla durante la ejecucion del script
Dim rootDSE, domainObject
'defino mi estructura de AD a inspeccionar
Set rootDSE=GetObject("LDAP://RootDSE")
domainContainer = rootDSE.Get("defaultNamingContext")
Set domainObject = GetObject("LDAP://" & domainContainer)
numdays = GetMaximumPasswordAge (domainContainer)
dp "Antiguedad maxima de password: " & numDays
If numDays > 0 Then 'chequeo que el dominio tenga la expiración de password habilitada
call ExportUsers(domainObject, numdays)
end if
Function GetMaximumPasswordAge (ByVal strDomainDN)
Dim objDomain, objMaxPwdAge
Dim dblMaxPwdNano, dblMaxPwdSecs, dblMaxPwdDays
Set objDomain = GetObject("LDAP://" & strDomainDN)
Set objMaxPWdAge = objDomain.maxPwdAge
If objMaxPwdAge.LowPart = 0 And objMaxPwdAge.Highpart = 0 Then
GetMaximumPasswordAge = 0
Else
dblMaxPwdNano = Abs (objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
dblMaxPwdDays = Int (dblMaxPwdSecs / SECONDS_IN_DAY)
GetMaximumPasswordAge = dblMaxPwdDays
End If
End Function
function ExportUsers (oObject,imaxpwdage)
Dim oUser
For Each oUser in oObject
Select Case oUser.Class
Case "user"
If Right (oUser.Name, 1) <> "$" Then
If IsEmpty (oUser.Mail) or IsNull (oUser.Mail) Then
dp Mid (oUser.Name, 4) & " no tiene mailbox"
Else
If UserIsExpired (oUser, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then
wscript.Echo "...enviando mail a " & oUser.Mail
Call SendEmail (oUser, iResult)
Else
dp "...no enviar mail"
End If
End If
End If
Case "organizationalUnit" , "container"
If UsersinOU (oUser) then
call ExportUsers(oUser,imaxpwdage)
End if
End select
Next
end function
Function UsersinOU (oObject)
Dim oUser
UsersinOU = False
for Each oUser in oObject
Select Case oUser.Class
Case "organizationalUnit" , "container"
UsersinOU = UsersinOU(oUser)
Case "user"
UsersinOU = True
End select
Next
End Function
Function UserIsExpired (objUser, iMaxAge, iDaysForEmail, iRes)
Dim intUserAccountControl, dtmValue, intTimeInterval
Dim strName
On Error Resume Next
Err.Clear
strName = Mid (objUser.Name, 4)
intUserAccountControl = objUser.Get ("userAccountControl")
If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
dp "El password para " & strName & " no expira."
UserIsExpired = False
Else
iRes = 0
dtmValue = objUser.PasswordLastChanged
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
UserIsExpired = True
dp "Nunca se seteo un password para " & strName & " "
Else
intTimeInterval = Int (Now - dtmValue)
dp "El password de " & strName & " fue establecido " & _
DateValue(dtmValue) & " a las " & TimeValue(dtmValue) & _
" (" & intTimeInterval & " dias atras)"
If intTimeInterval >= iMaxAge Then
dp "El password para " & strName & " ha expirado."
UserIsExpired = True
Else
iRes = Int ((dtmValue + iMaxAge) - Now)
dp "El password para " & strName & " expirara el " & _
DateValue(dtmValue + iMaxAge) & " dentro de " & _
iRes & " dias"
If iRes <= iDaysForEmail Then
dp strName & " Necesita un mail para cambio de password"
UserIsExpired = True
Else
dp strName & " No necesita cambio de password"
UserIsExpired = False
End If
End If
End If
End If
End Function
Sub SendEmail (objUser, iResult)
Dim objMail
Set objMail = CreateObject ("CDO.Message")
objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_SERVER
objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMail.Configuration.Fields.Update
objMail.From = STRFROM
objMail.To = objUser.Mail
objMail.Subject = "Se debe cambiar el password de " & Mid (objUser.Name, 4)
objMail.Textbody = "El password de " & objUser.userPrincipalName & _
" (" & objUser.sAMAccountName & ")" & vbCRLF & _
"expirara en " & iResult & " días." & vbCRLF & _
"Por favor cámbielo lo antes posible" & vbCRLF & vbCRLF & _
"Muchas Gracias," & vbCRLF & _
"Dpto. de sistemas"
objMail.Send
Set objMail = Nothing
End Sub
Sub dp (str)
If bDebug Then
WScript.Echo str
End If
End Sub
'---------------------hasta aca----------