Skrypt czyszczący kolejki SMTP serwera Exchange 2000/2003

Poniższy skrypt automatycznie czyści wybrane kolejki SMTP serwera Exchange 2000/2003. Jest bardzo przydatny w przypadku, gdy przez przypadek włączymy relying serwera Exchange lub musimy posprzątać kolejki po początkującym administratorze. Serwer pocztowy z włączonym relyingiem jest bardzo szybko wykrywany przez spamerów i w kolejkach SMTP pojawiają się tysiące wiadomości, których ręczne usuwanie staje się praktycznie niemożliwe.

Skrypt usuwa wiadomości z kolejek w taki sposób, że do ich nadawców nie są wysyłane raporty o niedoręczeniu, czyli jest to metoda No-NDR. Wiadomości usuwane są tylko z tych kolejek, które zawierają w nazwie kropkę, czyli są przeznaczone do wysłania na zewnątrz. W ten sposób omijane są kolejki przeznaczone do wewnętrznego przetwarzania i dostarczania wiadomości. Dodatkowo skrypt nie usuwa wiadomości przeznaczonych do dwóch domen zewnętrznych: Outlook.pl i CodeTwo.com (linia kodu oznaczona jako (*2)).

Skrypt napisany jest w VBA. Najwygodniej jest go uruchomić na serwerze Exchange w dowolnym edytorze VBA (Visual Basic for Applications) pakietu Office. Mamy wtedy możliwość śledzenia jego wykonywania, a wyniki możemy na bieżąco obserwować w oknie rezultatów (Immediate). W linii oznaczonej (*1) należy wpisać nazwę net bios serwera Exchange, na którym skrypt uruchamiamy, w przykładzie jest to serwera o nazwie ?alpha?. Następnie należy uruchomić procedurę o nazwie ClearQueuesInLoop.

Sub ClearQueuesInLoop()
    Dim bResult As Boolean
    bResult = True
    Do While bResult = True
        bResult = ClearQueues()
    Loop
   
End Sub

Function ClearQueues() As Boolean
   ClearQueues = False
   Set oWmi = GetObject("winmgmts://alpha/root/MicrosoftExchangeV2")
   Set oQueues = oWmi.InstancesOf("Exchange_SMTPQueue")
   For Each oQueue In oQueues
        Err.Clear
        On Error GoTo ErrorHandler
        If (InStr(oQueue.QueueName, ".") > 0) And _
           (InStr(oQueue.QueueName, "codetwo.com") = 0) And _ '(*2)
           (InStr(oQueue.QueueName, "outlook.pl") = 0) Then
            strQuery = "Select * From Exchange_QueuedSMTPMessage Where ProtocolName='SMTP' " & _
                                             " AND LinkID='" & oQueue.LinkID & "'" & _
                                             " AND LinkName='" & oQueue.LinkName & "'" & _
                                             " AND QueueID='" & oQueue.QueueID & "'" & _
                                             " AND QueueName='" & oQueue.QueueName & "'" & _
                                             " AND VirtualMachine='" & oQueue.VirtualMachine & "'" & _
                                             " AND VirtualServerName='" & oQueue.VirtualServerName & "'"

            Debug.Print oQueue.QueueName & " : " & oQueue.MessageCount
            
            Set oMessagesList = oWmi.ExecQuery(strQuery)
            If Not oMessagesList Is Nothing Then
                On Error Resume Next
                For Each oMessage In oMessagesList
                    Err.Clear
                    oMessage.DeleteNoNDR
                    If Err.Number <> 0 Then
                        Debug.Print "      Error " & oMessage.Sender & " " & oMessage.MessageId & " " & Err.Description
                    Else
                        ClearQueues = True
                        Debug.Print "      Success " & oMessage.MessageId
                    End If
                    Set oMessage = Nothing
                Next
                Set oMessagesList = Nothing
            End If
        End If
    Next
    
    Exit Function
    
ErrorHandler:
    MsgBox Err.Description
End Function

Jeśli masz jakieś pytania lub komentarze dotyczące tego artykułu, napisz na naszym forum.

(c) CodeTwo. Wszelkie prawa zastrzeżone.

© Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.