----------------------------------------- 
' vbscript to test end to end email connectivity. 
' We are trying to send and receive a message *exactly* as an end-user would. ie through Outlook 
' infrastructure. This way we can detect failures anywhere in the mail stream in both directions. 
' NB: Set option in Outlook NOT to save sent messages into sent mail. 
' 
' Uses the Redemption objects found at www.dimastr.com/redemption to 
' bypass the Outlook security model that triggers when programs and scripts try to send 
' email messages. 
' Relies on a mailbox being configured at a remote host (we use gmail) to bounce the message 
' back to the sender. 
' Known issues: 
' a) WUP cannot pass parameters into a script :( so you have to define all your paramters within 
'    the code itself 
' b) WUP can ONLY register 0 (Success) or 1 (Failure) from an Active monitor script. So it can only show 
'    whether mail is 'up' or 'down'. As we are checking the delay a message take on the round trip 
'    it would be possible to pass an integer value back - if only WUP could graph it. How about it guys? 
' 
' Al Blake - 20-Nov-2006 



option explicit 
Dim delay, subject, found, test, recipient 

subject = "E-Mail Flow Test:Poll" 
delay=500 
found=0 
recipient="bounce.account@domain.com" 

test = sendmail(recipient,subject) 
found = ReceiveMail(subject,delay) 
   
if found > 0 then 
        Context.SetResult 0, "Success" 
        'WScript.Echo("Found") 
else 
        Context.SetResult 1, "Failure" 
        'WScript.Echo("Fail") 
end if 

'--------------------------------------------------------------------- 
Function SendMail(recipient,subject) 
        Dim SafeItem, oItem, Application, Namespace, Sync  

        set Application = CreateObject("Outlook.Application") 
        set Namespace = Application.GetNamespace("MAPI") 
        Namespace.Logon "DEHUSR" 

        ' use safeitem otherwise we trigger the OL security junk 
        set SafeItem = CreateObject("Redemption.SafeMailItem") 'Create an instance of Redemption.SafeMailItem 
        set oItem = Application.CreateItem(0) 'Create a new message 
        SafeItem.Item = oItem 'set Item property 
        SafeItem.Recipients.Add recipient 
        SafeItem.Recipients.ResolveAll 
        SafeItem.Subject = subject 
        SafeItem.Send 
        
        ' unset variable to prevent memeory leaks 
        set SafeItem=nothing 
        set oItem=nothing 
        set sync=nothing 
        NameSpace.Logoff 
        Set Namespace=nothing 
        set application=nothing 
        sendmail=1 
End Function 
'--------------------------------------------------------------------- 
Function ReceiveMail(subject,delay) 



        Dim Application, NameSpace, olFolderInbox, oInbox, oMessages, oMessage, SentOn, SafeItem, oItem 

        olFolderInbox = 6 
        found=0 

        set NameSpace = CreateObject("Redemption.RDOSession") 
        Namespace.Logon "DEHUSR" 
        Set oInbox = NameSpace.GetDefaultFolder(olFolderInbox) 
        Set oMessages = oInBox.Items 
        
        For each oMessage in oMessages 
                SentOn = oMessage.SentOn 

                if DateDiff("s",Senton,Now()) < delay and oMessage.Subject = subject then 
                        found=1 
                                ' do a hard delete so the items dont 
                                ' build up in deleted items 
                                oMessage.Delete(2) 
                        Exit for 
                end if  
        Next 

        set oInBox=nothing 
        set oMessage=nothing 
        set oMessages=nothing 
        Namespace.logoff 
        set Namespace=nothing 
        set Application=nothing 

        ReceiveMail = found 

End Function  

 ------