Const sToAdmin	 	= "pass_admin@domain.tld"	'Административен имейл за получаване на обобщена сводка от изпълнението на скрипта
Const sFrom		= "helpdesk@domain.tld" 	'Имейл на подателя
Const iDaysToExp 	= 15				'Оставащи дни до изтичане на парола, ще бъдат уведомени само потребители с оставащи дни под тази стойност.
Const iDayOfWeek 	= 2				'2- Понеделник, 3- Вторник и т.н. - Деня в който се изпраща съобщение на тези с под iDaysToExp оставащи дни.
Const sLogFile	 	= "logfile.txt"
Const sSMTPServer	= "mail.domain.tld"		'СМТП сървър
Const iSMTPPort		= 25				'СМТП порт
Const iSMTPSendUsing	= 2				'Ползвай СМТП вместо Ексчейнж
Const iSMTPAuth		= 0				'Не се оторизирай
Const bSMTPUseSSL	= false				'Не ползвай ССЛ
Const sSMTPUsername	= "helpdesk"			'Потребителско име ??? 
Const sSMTPPassword	= ""				'Парола
Const sEmailFilter	= "@domain.tld"			'Филтър: трябва да се съдържа в емейл полето
Const bdryRun		= False				'True - няма да изпраща писма, само ще логва - за дебъг
Const iForAppending 	= 8

'		------------8<------------ Няма конфигурационни параметри за редактиране под тази линия. ------------8<------------

Sub LogMessage ( sMsg)
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set MyFile = fso.OpenTextFile(sLogFile, iForAppending, True)
	MyFile.WriteLine Now() &vbTab& sMsg
	MyFile.Close
End Sub
Sub sendEmail ( sTo, sSubject, sMsg )
	Dim emailObj, emailConfig
	
	On Error Resume Next
	Err.Clear
	LogMessage "Изпращане на писмо на:" &vbTab&  sTo
	Set emailObj      = CreateObject("CDO.Message")
	Set emailConfig = emailObj.Configuration	
	'
	emailObj.From = sFrom
	emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver")       = sSMTPServer	
	emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport")   = iSMTPPort
	emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing")        = iSMTPSendUsing
	emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = iSMTPAuth
	emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl")       = bSMTPUseSSL 
	emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername")     = sSMTPUsername
	emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword")     = sSMTPPassword
	emailConfig.Fields.Update

	emailObj.To       = sTo
	emailObj.Subject  = sSubject
	emailObj.HTMLBody=  sMsg
	emailObj.Send 
	If Err.Number <> 0 Then
		LogMessage "Error: " &vbTab& Err.Number &vbTab& Err.Description         						   
	End If 	
End Sub


Dim sAllUsersNotified,WshShell,oExec,strLine,aLine,iDays,sMail,sUser,sSubject,sHTMLBody
'On Error Resume Next
'
LogMEssage "Старт"
sAllUsersNotified = "<h2>Предупреждение за изтичане на паролата е изпратено на следните потребители:</h2><table border=""1px solid black"">"
Set WshShell = WScript.CreateObject("WScript.Shell")
'
Set oExec = WshShell.Exec ("FindExpAcc.exe  -outdelim "";"" -ps 200 -pwd -days "&iDaysToExp )
do while not oExec.StdOut.AtEndOfStream
	strLine= oExec.StdOut.ReadLine
	aLine = split(strLine, ";")
	'Дали има повече от 6 колони (маха излишните редове)
	if ( ((Ubound(aLine)+1) >6)  ) Then
			'Дали има валиден ел. адрес				
			if (InStr ( aLine(7), sEmailFilter) > 2 ) Then		
			iDays = Replace(aLine(6),"""","")
			sMail = Replace(aLine(7),"""","")
			sUser = Replace(aLine(2),"""","")
			' Премахва някой неточности в изхода
			if Not IsNumeric(iDays) Then iDays = -100 Else iDays = (iDays + 0) End If
			'
			'			
			' Само тези които имат все още валидна парола 			
			if ((iDays >= 0) And ((iDays = iDaysToExp) OR (Weekday(Now) = iDayOfWeek )) ) Then
					LogMessage "Намерен потребител:" &vbTab&  sUser &vbTab& sMail &vbTab& iDays
					sAllUsersNotified = sAllUsersNotified & bCrLf  & "<tr><td>"& sUser & "</td><td>" & Replace(aLine(3),"""","") & "</td><td>" & sMail & "</td><td>" & iDays & " дни </td></tr>"
					sSubject  = "Системно Съобщение"
					sHTMLBody=  "До: <i><b>" & sUser & "</b></i>," & _
										"<br>паролата Ви за достъп до служебния компютър, локалната мрежа и електронна поща в Министрство на финансите изтича след <i><b>" & iDays & "дни</b></i>." & _
										"<br>За да промените паролата си преди крайния срок моля, натиснете едновременно клавишите Ctrl,Alt и Del, след което изберете 'Change Password'." & _
										"<br><br><i>При възникнал проблем моля, обадете се на тел. 2040.<br>Това писмо е генерирано автоматично</i>"
					If (Not bDryRun) Then 
						sendEmail sMail,sSubject,sHTMLBody 
					End If

			End if		'if ((iDays >= 0) And ((iDays = iDaysToExp) OR (Weekday(Now) = iDayOfWeek )) ) Then
		End if			'if (InStr ( aLine(7), sEmailFilter) > 2 ) Then
	End if				'if ( ((Ubound(aLine)+1) >6)  ) Then
loop					'while not oExec.StdOut.AtEndOfStream

sAllUsersNotified = sAllUsersNotified & "</table>"
sSubject  = "Системно Съобщение - предупреждения за изтичащи пароли"
sHTMLBody = sAllUsersNotified
If (Not bDryRun) Then 
	sendEmail sToAdmin,sSubject,sHTMLBody
End If
LogMEssage "Стоп"