Locky .. Retrouver et supprimer des boites aux lettres le (les) mails corrompus #locky #ransomware #virus #lotusscript

Bonjour

 Si les bases de vos utilisateurs ont reçu des mails qui contiennent des virus comme locky, une des premières opérations, une fois que l'on a identifié les critères des mails, est de stopper l'infection en empêchant les utilisateurs de les ouvrir ..

Voici un script, que vous pourrez adapter pour trouver puis supprimer les mails des bases de vos utilisateurs sans avoir à le faire à la main.
 Il faut, bien sûr, soit le jouer en FullAdmin soit avoir les droits sur les bases ..

Voila ce que ca donne avec les log dans ma base d'outils

Et voilà le code de l'agent

 %REM
    Agent V - Scan des bases mail
    Created 13 mai 2016 by Thierry Laurent/Tilaune
    Description: Permet de supprimer des mails vérolés dans les bases de mails des utilisateurs
    ne fonctionne que si la base est indexée
    Il faut positionner les constantes de début du script pour aller vite mais on peut passer via des doc de
    paramètres
%END REM
Option Public
Option Declare



Dim thisdb As NotesDatabase
Dim db As NotesDatabase
Dim pos As Integer
Dim servername As String
Dim mailpath As String
Dim mailowner As String
Dim searchstring As String
Dim doccol As NotesDocumentCollection
Dim doc As NotesDocument
Dim docsuppr As NotesDocument


Dim doclog As NotesDocument

Sub Initialize
    'PARAMETERS TO CODE
    'Indicate mail subdirectory name
    mailpath = "mail\"
    'Server name (in canonical format) or leave blank for local server/directory:
    servername = "[le nom canonique du serveur]"
    'Indicate the string to search for
    searchstring = "la chaine de caractères que l'on cherche pour identifier le mail"
  
  
    Dim session As New NotesSession
    Set thisdb = session.CurrentDatabase
    Dim dbdir As New NotesDbDirectory(servername)
    'Cycle through databases on the server
    Set db = dbdir.GetFirstDatabase(DATABASE)
    While Not db Is Nothing


        'Skip databases which you don't have access to
        On Error 4060 GoTo Error4060
        'Check to see if this database is in the mail directory
        pos = InStr(LCase(db.FilePath), LCase(mailpath))
        'if the code find database the script begin
        If pos = 1 Then
            'open the database direct form the server
            Call db.Open(servername, db.FilePath)
            'Search for documents using search string
            'search the string in all documents database
            Set doccol = db.FTSearch(searchstring,0)
            'got to the frist document oin the database
            Set doc = doccol.GetFirstDocument
            'parse all document find
            While Not doc Is Nothing
                '==> Log détaillé
                'on crée le document de log pour savoir tout les documents détruits
                'you must create mask and view to view log document  
                Set docLog = thisdb.Createdocument()
                docLog.form="LogMailUser"
                doclog.LockyFullName = db.Title
                doclog.LockyMailDatabase = db.Filename
                doclog.LockyMailFilePath = db.Filepath
                doclog.LockyMailDateCreated = doc.Created
                doclog.LockyMailSubject = doc.Subject(0)
                doclog.LockyMailSender = doc.From(0)                          
                'comme on va détruire le document on se position sur le suivant avant de le détruire
                'if you want to keep the document in this database delete the rem bellow  
                'Copy all documents found to current database beware you need memo mask to see the mail
                'Call doc.CopyToDatabase(thisdb)
                Set docsuppr = doc
                Set doc = doccol.GetNextDocument(doc)
                'delete document form the database
                Call docsuppr.Removepermanently(True)              
                'save the log document
                Call doclog.Save(True,True)
              
            Wend
        End If
GetNextDb:
        Set db = dbdir.GetNextDatabase()
    Wend
    Exit Sub
Error4060:
    'If the code reaches here then the user does not have access rights.
    Resume GetNextDb
  
End Sub