Friday, November 15, 2013

Examples for search in Exchage anti-spam log and Report

Example: search Exchange anti-spam log by recipients:

Get-AgentLog | where {$_.recipients -like "myuser@mydomain.com"}

Example: search Exchange anti-spam log by sender:

Get-AgentLog | where {$_.P1FromAddress -like "user@contoso.com" -or $_.P2FromAddresses -like "user@corp.com"}

What different from P1FromAddress and P2FromAddresses? Example in telnet command:
"helo me
ehlo me
mail from:P1FromAddress
rcpt to:myuser@mydomain.com
data
mail from:P2FromAddresses
subject:test1
.
quit"


Example: search Exchange anti-spam log by sender domain:

Get-AgentLog | where {$_.P1FromAddress -like "*contoso.com" -or $_.P2FromAddress -like "*corp.com"}

Example: search Exchange anti-spam log by sender IP:

Get-AgentLog | where {$_.IPAddress -eq "7.7.7.7"}

Example: search Exchange anti-spam log by Reason: BlockListProvider:

Get-AgentLog | where {$_.Reason -eq "BlockListProvider"}

Example: search Exchange anti-spam log by Reason SclAtOrAboveQuarantineThreshold:

Get-AgentLog | where {$_.Reason -eq "SclAtOrAboveQuarantineThreshold"}

Example: search Exchange anti-spam log by Agent: Connection Filtering Agent:

Get-AgentLog | where {$_.Agent -eq "Connection Filtering Agent"}

Example: search Exchange anti-spam log by Agent: SenderID Agent:

Get-AgentLog | where {$_.Agent -eq "SenderID Agent"}

Example: search Exchange anti-spam log by Agent: Sender Filter Agent:

Get-AgentLog | where {$_.Agent -eq "Sender Filter Agent"}

Example: search Exchange anti-spam log by Agent: Recipient Filter Agent:

Get-AgentLog | where {$_.Agent -eq "Recipient Filter Agent"}

Example: search Exchange anti-spam log by Agent: Edge Rules Agent:

Get-AgentLog | where {$_.Agent -eq "Edge Rules Agent"}

And the mail report daily and weekly statistics:


Add-PSSnapIn Microsoft.Exchange.Management.PowerShell.E2010
$HTMLReport = ".\report.html"
$MailTo = "myuser@mydomain.com"
$MailServer = "internal server ip"
$MailFrom = "mystat@mydomain.com"

$a1 = Get-AgentLog -StartDate (Get-Date).AddDays(-1) -EndDate (Get-Date)
$a2 = $a1 | where { $_.Action -like "RejectMessage" -or $_.Action -like "RejectCommand" -or $_.Action -like "QuarantineMessage" }
$a3 = $a1 | where { $_.Action -like "AcceptMessage" }

$b1 = Get-AgentLog -StartDate (Get-Date).AddDays(-7) -EndDate (Get-Date)
$b2 = $b1 | where { $_.Action -like "RejectMessage" -or $_.Action -like "RejectCommand" -or $_.Action -like "QuarantineMessage" }
$b3 = $b1 | where { $_.Action -like "AcceptMessage" }

$Output = "<html> 
<body> 
<font size=""1"" face=""Arial,sans-serif""> 
<h3 align=""center"">Exchange Antispam Report</h3> 
<h5 align=""center"">Generated $((Get-Date).ToString())</h5> 
</font> 
<table border=""0"" cellpadding=""3"" style=""font-size:8pt;font-family:Arial,sans-serif""> 
<tr bgcolor=""#009900""> 
<th><font color=""#ffffff"">Recieved Messages per day:</font></th> 
<th><font color=""#ffffff"">Rejected Messages per day:</font></th> 
<th><font color=""#ffffff"">% Rejected Messages per day:</font></th> 
<th><font color=""#ffffff"">Accepted Messages per day:</font></th> 
<th><font color=""#ffffff"">% Accepted Messages per day:</font></th></tr>
<tr bgcolor=""#dddddd""><th>$($a1.count)</th>
<th>$($a2.count)</th>
<th>$([math]::Round(($a2.count/$a1.count)*100))</th>
<th>$($a3.count)</th>
<th>$([math]::Round(($a3.count/$a1.count)*100))</th>
</tr></table>
<table border=""0"" cellpadding=""3"" style=""font-size:8pt;font-family:Arial,sans-serif""> 
<tr bgcolor=""#009900""> 
<th><font color=""#ffffff"">Recieved Messages per week:</font></th> 
<th><font color=""#ffffff"">Rejected Messages per week:</font></th> 
<th><font color=""#ffffff"">% Rejected Messages per week:</font></th> 
<th><font color=""#ffffff"">Accepted Messages per week:</font></th> 
<th><font color=""#ffffff"">% Accepted Messages per week:</font></th></tr>
<tr bgcolor=""#dddddd""><th>$($b1.count)</th>
<th>$($b2.count)</th>
<th>$([math]::Round(($b2.count/$b1.count)*100))</th>
<th>$($b3.count)</th>
<th>$([math]::Round(($b3.count/$b1.count)*100))</th>
</tr></table>
</body></html>";

$Output | Out-File $HTMLReport

Send-MailMessage -Attachments $HTMLReport -To $MailTo -From $MailFrom -Subject "Exchange Antispam Report" -BodyAsHtml $Output -SmtpServer $MailServer

Thursday, November 7, 2013

DNS query from MS Excel VBA


Sometimes it is necessary to resolve names (DNS HostA), or ip addresses (DNS PTR) in large numbers. Search in google.com found two articles on the forum "http://stackoverflow.com/questions/2215203/vb6-lookup-hostname-from-ip-specifying-dns-server ", "http://stackoverflow.com/questions/2256321/vb6-windows-api-call-to-dnsquery-function-and-pointer-question" Compiled code with these got this:

Download the sample file of 64bit MS Excel to query DNS A and PTR ​​records

Option Explicit

Private Declare Function DnsQuery Lib "dnsapi" Alias "DnsQuery_A" (ByVal strname As String, ByVal wType As Integer, ByVal fOptions As Long, ByVal pServers As Long, ppQueryResultsSet As Long, ByVal pReserved As Long) As Long
Private Declare Function DnsRecordListFree Lib "dnsapi" (ByVal pDnsRecord As Long, ByVal FreeType As Long) As Long
Private Declare Function lstrlen Lib "kernel32" (ByVal straddress As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Function inet_ntoa Lib "ws2_32.dll" (ByVal pIP As Long) As Long
Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal sAddr As String) As Long

Private Const DnsFreeRecordList         As Long = 1
Private Const DNS_TYPE_A                As Long = &H1
Private Const DNS_TYPE_PTR              As Long = &HC
Private Const DNS_QUERY_BYPASS_CACHE    As Long = &H8

Private Type VBDnsRecord
    pNext           As Long
    pName           As Long
    wType           As Integer
    wDataLength     As Integer
    flags           As Long
    dwTel           As Long
    dwReserved      As Long
    prt             As Long
    others(35)      As Byte
End Type

Sub DNS_Resolve()
Dim strDName As String
Dim strDNames As Variant

Dim a, b
a = 2
b = 2

'Resolution PTR
While Not IsEmpty(Worksheets("Sheet1").Cells(a, 1))
strDName = Trim(Worksheets("Sheet1").Cells(a, 1))
strDNames = Split(strDName, ".")
strDName = strDNames(3) + "." + strDNames(2) + "." + strDNames(1) + "." + strDNames(0)
strDName = strDName + ".in-addr.arpa"
Worksheets("Sheet1").Cells(a, 2) = Resolve2(strDName, "8.8.8.8")
    a = a + 1
Wend

'Resolution HostA
While Not IsEmpty(Worksheets("Sheet1").Cells(b, 3))
strDName = Worksheets("Sheet1").Cells(b, 3)
Worksheets("Sheet1").Cells(b, 4) = Resolve(strDName, "8.8.8.8")
    b = b + 1
Wend

MsgBox ("Complete")

End Sub

'Resolution PTR
Private Function Resolve2(sAddr As String, Optional sDnsServers As String) As String
    Dim pRecord     As Long
    Dim pNext       As Long
    Dim uRecord     As VBDnsRecord
    Dim lPtr        As Long
    Dim vSplit      As Variant
    Dim laServers() As Long
    Dim pServers    As Long
    Dim sName       As String

    If LenB(sDnsServers) <> 0 Then
        vSplit = Split(sDnsServers)
        ReDim laServers(0 To UBound(vSplit) + 1)
        laServers(0) = UBound(laServers)
        For lPtr = 0 To UBound(vSplit)
            laServers(lPtr + 1) = inet_addr(vSplit(lPtr))
        Next
        pServers = VarPtr(laServers(0))
    End If
    If DnsQuery(sAddr, DNS_TYPE_PTR, DNS_QUERY_BYPASS_CACHE, pServers, pRecord, 0) = 0 Then
        pNext = pRecord
        Do While pNext <> 0
            Call CopyMemory(uRecord, pNext, Len(uRecord))
            If uRecord.wType = DNS_TYPE_PTR Then
                lPtr = uRecord.prt
                sName = String(lstrlen(lPtr), 0)
                Call CopyMemory(ByVal sName, lPtr, Len(sName))
                If LenB(Resolve2) <> 0 Then
                    Resolve2 = Resolve2 & " "
                End If
                Resolve2 = Resolve2 & sName
            End If
            pNext = uRecord.pNext
        Loop
        Call DnsRecordListFree(pRecord, DnsFreeRecordList)
    End If
End Function

'Resolution HostA
Private Function Resolve(sAddr As String, Optional sDnsServers As String) As String
    Dim pRecord     As Long
    Dim pNext       As Long
    Dim uRecord     As VBDnsRecord
    Dim lPtr        As Long
    Dim vSplit      As Variant
    Dim laServers() As Long
    Dim pServers    As Long
    Dim sName       As String

    If LenB(sDnsServers) <> 0 Then
        vSplit = Split(sDnsServers)
        ReDim laServers(0 To UBound(vSplit) + 1)
        laServers(0) = UBound(laServers)
        For lPtr = 0 To UBound(vSplit)
            laServers(lPtr + 1) = inet_addr(vSplit(lPtr))
        Next
        pServers = VarPtr(laServers(0))
    End If
    If DnsQuery(sAddr, DNS_TYPE_A, DNS_QUERY_BYPASS_CACHE, pServers, pRecord, 0) = 0 Then
        pNext = pRecord
        Do While pNext <> 0
            Call CopyMemory(uRecord, pNext, Len(uRecord))
            If uRecord.wType = DNS_TYPE_A Then
                lPtr = inet_ntoa(uRecord.prt)
                sName = String(lstrlen(lPtr), 0)
                Call CopyMemory(ByVal sName, lPtr, Len(sName))
                If LenB(Resolve) <> 0 Then
                    Resolve = Resolve & " "
                End If
                Resolve = Resolve & sName
            End If
            pNext = uRecord.pNext
        Loop
        Call DnsRecordListFree(pRecord, DnsFreeRecordList)
    End If
End Function


The result will be something like this



For 64-bit version of Office you need to change a little code:

Option Explicit

Private Declare PtrSafe Function DnsQuery Lib "dnsapi" Alias "DnsQuery_A" (ByVal strname As String, ByVal wType As Integer, ByVal fOptions As Long, ByVal pServers As LongLong, ppQueryResultsSet As Long, ByVal pReserved As Long) As Long
Private Declare PtrSafe Function DnsRecordListFree Lib "dnsapi" (ByVal pDnsRecord As Long, ByVal FreeType As Long) As Long
Private Declare PtrSafe Function lstrlen Lib "kernel32" (ByVal straddress As Long) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare PtrSafe Function inet_ntoa Lib "ws2_32.dll" (ByVal pIP As Long) As Long
Private Declare PtrSafe Function inet_addr Lib "ws2_32.dll" (ByVal sAddr As String) As Long

Private Const DnsFreeRecordList         As Long = 1
Private Const DNS_TYPE_A                As Long = &H1
Private Const DNS_TYPE_PTR              As Long = &HC
Private Const DNS_QUERY_BYPASS_CACHE    As Long = &H8

Private Type VBDnsRecord
    pNext           As Long
    pName           As LongPtr
    wType           As Integer
    wDataLength     As Integer
    flags           As Long
    dwTel           As Long
    dwReserved      As Long
    prt             As Long
    others(35)      As Byte
End Type

Sub DNS_Resolve()
Dim strDName As String
Dim strDNames As Variant

Dim a, b
a = 2
b = 2

While Not IsEmpty(Worksheets("Sheet1").Cells(a, 1))
strDName = Trim(Worksheets("Sheet1").Cells(a, 1))
strDNames = Split(strDName, ".")
strDName = strDNames(3) + "." + strDNames(2) + "." + strDNames(1) + "." + strDNames(0)
strDName = strDName + ".in-addr.arpa"
Worksheets("Sheet1").Cells(a, 2) = Resolve2(strDName, "8.8.8.8")
    a = a + 1
Wend

While Not IsEmpty(Worksheets("Sheet1").Cells(b, 3))
strDName = Worksheets("Sheet1").Cells(b, 3)
Worksheets("Sheet1").Cells(b, 4) = Resolve(strDName, "8.8.8.8")
    b = b + 1
Wend

MsgBox ("Complete")

End Sub

Private Function Resolve(sAddr As String, Optional sDnsServers As String) As String
    Dim pRecord     As Long
    Dim pNext       As Long
    Dim uRecord     As VBDnsRecord
    Dim lPtr        As Long
    Dim vSplit      As Variant
    Dim laServers() As Long
    Dim pServers    As LongLong
    Dim sName       As String

    If LenB(sDnsServers) <> 0 Then
        vSplit = Split(sDnsServers)
        ReDim laServers(0 To UBound(vSplit) + 1)
        laServers(0) = UBound(laServers)
        For lPtr = 0 To UBound(vSplit)
            laServers(lPtr + 1) = inet_addr(vSplit(lPtr))
        Next
        pServers = VarPtr(laServers(0))
    End If

    If DnsQuery(sAddr, DNS_TYPE_A, DNS_QUERY_BYPASS_CACHE, pServers, pRecord, 0) = 0 Then
        pNext = pRecord
        Do While pNext <> 0
            Call CopyMemory(uRecord, pNext, Len(uRecord))
            If uRecord.wType = DNS_TYPE_A Then
                lPtr = inet_ntoa(uRecord.prt)
                sName = String(lstrlen(lPtr), 0)
                Call CopyMemory(ByVal sName, lPtr, Len(sName))
                If LenB(Resolve) <> 0 Then
                    Resolve = Resolve & " "
                End If
                Resolve = Resolve & sName
            End If
            pNext = uRecord.pNext
        Loop
        Call DnsRecordListFree(pRecord, DnsFreeRecordList)
    End If
End Function

Private Function Resolve2(sAddr As String, Optional sDnsServers As String) As String
    Dim pRecord     As Long
    Dim pNext       As Long
    Dim uRecord     As VBDnsRecord
    Dim lPtr        As Long
    Dim vSplit      As Variant
    Dim laServers() As Long
    Dim pServers    As LongLong
    Dim sName       As String

        If LenB(sDnsServers) <> 0 Then
            vSplit = Split(sDnsServers)
            ReDim laServers(0 To UBound(vSplit) + 1)
            laServers(0) = UBound(laServers)
            For lPtr = 0 To UBound(vSplit)
                laServers(lPtr + 1) = inet_addr(vSplit(lPtr))
            Next
            pServers = VarPtr(laServers(0))
        End If

    If DnsQuery(sAddr, DNS_TYPE_PTR, DNS_QUERY_BYPASS_CACHE, pServers, pRecord, 0) = 0 Then
        pNext = pRecord
        Do While pNext <> 0
            Call CopyMemory(uRecord, pNext, Len(uRecord))
            If uRecord.wType = DNS_TYPE_PTR Then
                lPtr = uRecord.prt
                sName = String(lstrlen(lPtr), 0)
                Call CopyMemory(ByVal sName, lPtr, Len(sName))
                If LenB(Resolve2) <> 0 Then
                    Resolve2 = Resolve2 & " "
                End If
                Resolve2 = Resolve2 & sName
            End If
            pNext = uRecord.pNext
        Loop
        Call DnsRecordListFree(pRecord, DnsFreeRecordList)
    End If
End Function