March, 2009

using System;
using System.Collections.Generic;
using System.Text;
using System.Management.Automation.Runspaces;
using System.Collections.ObjectModel;

namespace PowershellSample
{
    class Program
    {
        static void Main(string[] args)
        {
            RunspaceConfiguration config = RunspaceConfiguration.Create();
            PSSnapInException warning;

            // Load Exchange PowerShell snap-in.
            config.AddPSSnapIn("Microsoft.Exchange.Management.PowerShell.Admin", out warning);
            if (warning != null) throw warning;


            using (Runspace thisRunspace = RunspaceFactory.CreateRunspace(config))
            {
                try
                {
                    thisRunspace.Open();
                    using (Pipeline thisPipeline = thisRunspace.CreatePipeline())
                    {
                        //Please change parameter values.
                        Command cmdGetMailbox = new Command("Get-MailboxServer");
                        Command cmdAddAdPermission = new Command("Add-AdPermission");

                        cmdGetMailbox.Parameters.Add("Identity", @"MSGEX07");
                        cmdAddAdPermission.Parameters.Add("User", "UserA");
                        cmdAddAdPermission.Parameters.Add("AccessRights", new string[] { "GenericRead", "GenericWrite" });
                        cmdAddAdPermission.Parameters.Add("ExtendedRights", new string[] { "Send-As", "Receive-As", "ms-Exch-Store-Admin" });

                        thisPipeline.Commands.Add(cmdGetMailbox);
                        thisPipeline.Commands.Add(cmdAddAdPermission);

                        try
                        {
                            thisPipeline.Invoke();
                        }
                        catch (Exception exx)
                        {
                            Console.Write("Error: " + exx.ToString());
                        }

                        // Check for errors in the pipeline and throw an exception if necessary.
                        if (thisPipeline.Error != null && thisPipeline.Error.Count > 0)
                        {
                            StringBuilder pipelineError = new StringBuilder();
                            pipelineError.AppendFormat("Error calling cmdLets...");
                            foreach (object item in thisPipeline.Error.ReadToEnd())
                            {
                                pipelineError.AppendFormat("{0}\n", item.ToString());
                            }

                            throw new Exception(pipelineError.ToString());
                        }
                    }
                }

                finally
                {
                    thisRunspace.Close();
                }

            }
        }
    }
}

Option Explicit

'Constant variable declarations
CONST ADS_ACETYPE_ACCESS_ALLOWED = 0
CONST ADS_ACETYPE_ACCESS_DENIED = 1
CONST ADS_ACETYPE_SYSTEM_AUDIT = 2
CONST ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = 5
CONST ADS_ACETYPE_ACCESS_DENIED_OBJECT = 6
CONST ADS_ACETYPE_SYSTEM_AUDIT_OBJECT = 7
CONST ADS_ACETYPE_SYSTEM_ALARM_OBJECT = 8 
CONST ADS_RIGHT_DS_CREATE_CHILD = 1
CONST ADS_ACEFLAG_INHERIT_ACE = 2

'Used for Associate external account
Const E2K_MB_FULL_MB_ACCESS = &H1
Const E2K_MB_SEND_AS = &H2
Const E2K_MB_EXTERNAL_ACCOUNT = &H4
Const E2K_MB_READ_PERMISSIONS = &H20000
Const E2K_MB_TAKE_OWNERSHIP = &H80000


' ********************************************************************
' Change these variables according to your environment.

Const sUserADsPath = "LDAP://SERVER/CN=USER,CN=Users,DC=ExchangeLab,DC=com"
Const sTrustee = "NT AUTHORITY\SELF"
' ********************************************************************


Dim objUser
Dim oSecurityDescriptor 
Dim dacl 
Dim ace 

Dim bFound 

bFound = False
'Get directory user object.
Set objUser = GetObject(sUserADsPath)

' Get the Mailbox security descriptor (SD).
Set oSecurityDescriptor = objUser.MailboxRights

' Extract the Discretionary Access Control List (DACL) using the IADsSecurityDescriptor.
' Interface.
Set dacl = oSecurityDescriptor.DiscretionaryAcl
Set ace = CreateObject("AccessControlEntry")

AddAce dacl, sTrustee, E2K_MB_FULL_MB_ACCESS Or E2K_MB_EXTERNAL_ACCOUNT, ADS_ACETYPE_ACCESS_ALLOWED, ADS_ACEFLAG_INHERIT_ACE, 0, 0, 0


' Add the modified DACL to the security descriptor.
oSecurityDescriptor.DiscretionaryAcl = dacl

' Save new SD onto the user.
objUser.MailboxRights = oSecurityDescriptor

' Commit changes from the property cache to the information store.
objUser.SetInfo

wscript.echo "Done modifying the mailboxsecurity descriptor"



'********************************************************************
'*
'* Function AddAce(dacl, TrusteeName, gAccessMask, gAceType,
'*          gAceFlags, gFlags, gObjectType, gInheritedObjectType)
'*
'* Purpose: Adds an ACE to a DACL
'* Input:   dacl            Object's Discretionary Access Control List
'*          TrusteeName     SID or Name of the trustee user account
'*          gAccessMask     Access Permissions
'*          gAceType        ACE Types
'*          gAceFlags       Inherit ACEs from the owner of the ACL
'*          gFlags          ACE has an object type or inherited object type
'*          gObjectType     Used for Extended Rights
'*          gInheritedObjectType
'*
'* Output:  Object - New DACL with the ACE added
'*
'********************************************************************

Function AddAce(dacl, TrusteeName, gAccessMask, gAceType, gAceFlags, gFlags, gObjectType, gInheritedObjectType)
    Dim Ace1
    ' Create a new ACE object.
    Set Ace1 = CreateObject("AccessControlEntry")
    Ace1.AccessMask = gAccessMask
    Ace1.AceType = gAceType
    Ace1.AceFlags = gAceFlags
    Ace1.Flags = gFlags
    Ace1.Trustee = TrusteeName
    'See whether ObjectType must be set
    If CStr(gObjectType) <> "0" Then
       Ace1.ObjectType = gObjectType
    End If

    'See whether InheritedObjectType must be set.
    If CStr(gInheritedObjectType) <> "0" Then
        Ace1.InheritedObjectType = gInheritedObjectType
    End If

    dacl.AddAce Ace1



    ' Destroy objects.
    Set Ace1 = Nothing
End Function

Const strServer = "ExchangeServerName"                            ' Exchange 2003 Server's HOSTNAME/IPADDRESS

Const strDomain = "ExchangeLab"                        ' Credentials to login to mailbox
Const strUser = "Administrator"                        ' It could be credentials for the same mailbox
Const strPass = "********"                            ' or the credentials of a service account which has access to all mailboxes

Const strMailBox = "Administrator"                    ' Mailbox alias to login to
Const strFrom = "administrator@exchangelab.com"        ' From address of sender, ideally should be same as the Mailbox
Const strTo = "administrator@exchangelab.com"        ' Email sent TO
Const strSubject = "Unread mails alert!"            ' Email's subject
Const strBody = "You have {X} unread emails"         ' leave the {X} as is and this will be replaced with the actual number of unread message 
Const SSL_Enabled = ""                                ' change this to "s" if you want to enable SSL (HTTPS)
Const MaxUnreadAllowed = 10                            ' change it to maximum unread allowed in an inbox

Const strLogFilePath = "C:\UnreadEmailMonitor.log"    ' Change to the file path where you want to save the log


Dim xDoc
Dim xNodes
Dim strURL
Dim strResponse
Dim HttpWebRequest
Dim strXMLRequest
Dim strUnreadCount

strXMLRequest = "<?xml version=""1.0""?>"
strXMLRequest = strXMLRequest + "<D:propfind xmlns:D=""DAV:"" xmlns:z=""urn:schemas:httpmail:"">"
strXMLRequest = strXMLRequest + "<D:prop><z:unreadcount/></D:prop>"
strXMLRequest = strXMLRequest + "</D:propfind>"

strURL = "http" & SSL_Enabled & "://" & strServer & "/Exchange/" & strMailBox & "/Inbox"

Set HttpWebRequest = CreateObject("microsoft.xmlhttp")
Set xDoc = CreateObject("MSXML.DOMDocument")

HttpWebRequest.open "PROPFIND", strURL, False, strUser, strPass
HttpWebRequest.setRequestHeader "Content-type:", "text/xml"
HttpWebRequest.send strXMLRequest

WriteLog "Polling unread count from mailbox : " & strMailBox

If (HttpWebRequest.Status >= 200 And HttpWebRequest.Status < 300) Then
   WriteLog "Success downloading mailbox data"
ElseIf HttpWebRequest.Status = 401 Then
   WriteLog "You don't have permission to connect to this mailbox: " & strMailBox
Else
   WriteLog "Error downloading mailbox data. Status: " & HttpWebRequest.Status & ": " & HttpWebRequest.statusText
End If

strResponse = HttpWebRequest.responseText


If xDoc.loadXML(strResponse) Then

Dim startPos
Dim endPos
Dim ns

    endPos = InStr(strResponse, "=""urn:schemas:httpmail:")
    startPos = InStrRev(strResponse, "xmlns:", endPos) + 6
    ns = Mid(strResponse, startPos, endPos - startPos)
    strUnreadCount = xDoc.selectSingleNode("//" & ns & ":unreadcount").Text
End If

If strUnreadCount > MaxUnreadAllowed Then 

WriteLog "Unread emails found: " & strUnreadCount & " , sending mail to " & strTo

strURL = "http" & SSL_Enabled & "://" & strServer & "/Exchange/" & strUser & "/##DavMailSubmissionURI##"
HttpWebRequest.open "PUT", strURL, False, strDomain & "\" & strUser, strPass

        
strXMLRequest = "From: " & strFrom & vbNewLine & _
"To: " & strTo & vbNewLine & _
"Subject: " & strSubject & vbNewLine & _
"Date: " & Now() & vbNewLine & _
"X-Mailer: Mailbox Polling Application" & vbNewLine & _
"MIME-Version: 1.0" & vbNewLine & _
"Content-Type: text/html" & vbNewLine & _
"Charset = ""iso-8859-1""" & vbNewLine & _
"Content-Transfer-Encoding: 7bit" & vbNewLine & vbNewLine & _
Replace(strBody, "{X}", strUnreadCount)

HttpWebRequest.setRequestHeader "Translate", "f"
HttpWebRequest.setRequestHeader "Content-Type", "message/rfc822"
HttpWebRequest.setRequestHeader "Content-Length", "" & Len(strXMLRequest)
HttpWebRequest.send strXMLRequest
    
 If (HttpWebRequest.Status >= 200 And HttpWebRequest.Status < 300) Then
   WriteLog "Message successfully sent."
 ElseIf HttpWebRequest.Status = 401 Then
   WriteLog "You don't have permission to send the Message."
 Else
   WriteLog "Message not successfully sent. Status: " & HttpWebRequest.Status & ": " & HttpWebRequest.statusText
 End If
End If

 
Private Sub WriteLog(ByVal sText)
    Dim objFSO
    Dim objTextFile
    
    Const ForAppending = 8
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTextFile = objFSO.OpenTextFile(strLogFilePath, ForAppending, True)
    
    ' Write a line.
    objTextFile.Write (sText & vbCRLFde)

    objTextFile.Close
    'objTextFile.Close

End Sub