Antispam artigianale, ovvero occhio agli sconosciuti!

Antispam artigianale, ovvero occhio agli sconosciuti!

Indubbiamente quello dello Spam è un tormento un po’ per tutti. Negli ultimi tempi, almeno per quel che mi riguarda, il fastidio sembra attenuato, ma non è cessato il tormentone. Tormentone di chi? Ma dei produttori di antivirus e antispam, diamine! Che ci terrorizzano con questa pur tediosa minaccia e gareggiano nel vantare la propria merce. Ad esempio mi è rimasta impressa l’affermazione di uno di costoro di aver messo in atto un sofisticato sistema di riconoscimento caratteri per smascherare gli spammisti che ormai usano immagini e non testo per pubblicizzare cose ben note come Viagra & simili.

Lungi da me l’intenzione di sminuire così avanzate ricerche, faccio solo osservare quel che, d’altronde, dicono i migliori esperti:

Ø      Lo spam maligno (non quello solo scocciante e/o burlone) colpisce solo chi avventatamente risponde o, peggio ancora, apre un attachment;

Ø      Di conseguenza, ciascuno è il miglior medico di se stesso se avrà la semplice accortezza di controllare e, se occorre, eliminare (Maiusc + Canc) la mail sospetta prima di aprirla o, peggio, di aprirne un alllegato.

Quanto ai sospetti, i criteri sono due: mittente (tuttora) sconosciuto e presenza di attachment. La routine che propongo serve ad aiutarci a individuare l’una e l’altra cosa, lasciandoci comunque la responsabilità dell’azione.

Premessa esplorativa

In ogni caso ritengo non trascurabile la valenza didattica del codice seguente, che ribadisce oggetti e proprietà del VBA di Outlook, questo sconosciuto.

Cominciamo con una routine esplorativa, che scrive nella finestra Immediata (Ctrl + g per visualizzarla) il nome completo e l’indirizzo e-mail principale di tutti i nostri Contatti.

Sub EsploraIndirizzi()

  Dim Nms As NameSpace

  Set Nms = GetNamespace("MAPI") 'N.B. - In altri mondi (es. Excel) occorre:

  'Set Nms = Outlook.GetNamespace("MAPI") 'ossia premettere "Outlook."

  Dim Indirizzi As MAPIFolder

  Set Indirizzi = Nms.GetDefaultFolder(olFolderContacts)

  'MsgBox Indirizzi.Items.Count 'serve per debug…

  Dim Indir As ContactItem

  On Error Resume Next 'Necessario per casi estremi...

  For Each Indir In Indirizzi.Items

    Debug.Print Indir.FullName, Indir.Email1Address

  Next

End Sub

Sul significato del Namespace e sulla necessità di impostarlo preliminarmente come “MAPI” ho già scritto altri post, cui rimando, ad esempio questo:

http://blog.shareoffice.it/giannigiaccaglini/articles/6440.aspx

Di un certo interesse è il ciclo For Each Indir ... Next , cui non solo forse non tutti pensano ma che ha il pregio di lavorare con la variabile Indir preliminarmente definita come ContactItem  In tal modo l’Intellisense ci aiuta suggerendo, dopo il punto (.) le proprietà di un oggetto ContactItem. Qualcuno si chiederà se non andava altrettanto bene l’equivalente loop indicizzato:

  For i = 1 To Indirizzi.Items.Count

    Debug.Print Indirizzi.Items(i).Fullname ... (ecc.)

  Next

Risposta negativa, perché Items è una proprietà, come dire?, generica che si attaglia a svariati insiemi folder, come la posta in arrivo e spedita, così nel predetto ciclo Indirizzi.Items(i) non esibisce proprietà alcuna, accanto al punto.

La Sub EsploraIndirizzi potrà servire tra l’altro ad individuare doppioni e indirizzi privi di e-mail. In genere converrà eliminare questi ultimi. I più audaci potrebbero addirittura ricorrere a un sistematico repulisti:

  msg = "e-mail assente: cancello il contatto?” 

  For Each Indir In Indirizzi.Items

    If Indir.Email1Address = "" then

       If MsgBox(Msg,VbYesNo) = Vbyes then Indir.Delete

    End if

  Next

(Ma a vostro rischio & pericolo, e non chiedetemi rimborsi per eventuali perdite di dati).

La semplice ricetta

Consiste nella routine seguente:

Sub VerificaEstranei()

  'Antispam artigiano, applicato all'UNICO

  'messaggio arrivato selezionato

  Dim Nms As NameSpace

  Set Nms = GetNamespace("MAPI") 'NB - In altri mondi (es. Excel) occorre:

  'Set Nms = Outlook.GetNamespace("MAPI") 'ossia premettere "Outlook."

  Dim Indirizzi As MAPIFolder

  Set Indirizzi = Nms.GetDefaultFolder(olFolderContacts)

  Dim OlSel As Selection 'NB In altri mondi: ... As Outlook.Selection

  Dim Indir As ContactItem, Mitt As String, EstInContatti As Boolean

  Set OlSel = ActiveExplorer.Selection

  Dim MessArr As MailItem 'messaggio in arrivo, da esaminare

  Set MessArr = OlSel.Item(1) 'Il primo messaggio, l'unico

      'che questa Sub tratta

  If MessArr.Attachments.Count > 0 Then

    MsgBox MessArr.SenderName & vbLf & "Contiene Allegati!", vbCritical, ""

  End If

  Mitt = Trim(MessArr.SenderName)

  For Each Indir In Indirizzi.Items

    If Indir.FullName = Mitt Then

      EstInContatti = True

      Exit For

    End If

  Next

  If Not EstInContatti Then

    MsgBox "Mittente assente nei Contatti...", vbCritical, ""

  End if

End Sub

Osservazioni? Chi è giunto sin qui penso che abbia tutti gli elementi per cavarsela da solo, quindi mi limito a dire due sole cose.

• Per quel che riguarda il codice: SenderName è ovviamente il nome del mittente e fa pendant con il FullName del contatto.
• Per quel che riguarda l’uso, si deve selezionare, prima del lancio, un messaggio (*) in arrivo: la macro segnalerà se esso reca allegati e/o se fa già parte del repertorio contatti. La decisione da prendere

Va da sé che la segnalazione di estranei sarà abbastanza frequente, specie nei primi tempi. Sarà l’occasione per decidersi ad aggiungere il nuovo venuto, con una manovra che tutti sanno, ma che non guasta rammentare:

1. Selezionare il messaggio in arrivo;
2. eseguirne il drag and drop sull’icona Contatti del riquadro “Posta elettronica” di Outlook, posta di solito a sinistra in basso.

Trasferimento semiautomatico nella cartella Indesiderati

Il codice che sto per proporre si rivolge a gente esperta, pertanto i commenti sono ridotti all’essenziale. Gl’interessati potranno valutare se e come integrare la routine principale – TrasferMessInCartIndes con la precedente.

L’obiettivo, stavolta, è quello di trasferire il messaggio in arrivo selezionato nella cartella della Posta indesiderata. Prima di proseguire sottopongo all’inclita e anche al volgo questa routinetta esplorativa:

Sub EsploraMieCartelle()

  'Dim Nms As NameSpace

  'Set Nms = GetNamespace("MAPI")

  Dim MieCart As Folders 'Cartelle figlie di "Cartelle personali"

  'Msgbox Nms.Folders.Count di regola dà 1 e

  'Nms.Folders(1).Name dà "Cartelle personali

  Set MieCart = GetNamespace("MAPI").Folders("Cartelle personali").Folders

  Dim MiaCart As MAPIFolder

  For Each MiaCart In MieCart

     Debug.Print MiaCart.Name

  Next

End Sub

Lanciandola, si dovrà vedere nella finestra Immediata (Ctrl+g per visualizzarla) i nomi seguenti:

Posta eliminata

Posta in arrivo

Posta in uscita

Posta inviata

Calendario

Contatti

Diario

Note

Attività

Bozze

Posta indesiderata

Tornando alla Sub precedente, faccio notare anzitutto che, almeno in questo caso, ho evitato, traducendola in commento, l’istruzione iniziale di acquisizione (Get) del Namespace “MAPI”, inserendola in seno a quella di fissazione delle cartelle:

Get MieCart = GetNamespace("MAPI").Folders(….)

Come si noterà, sempre in situazioni normali, le cartelle (Folder) che interessano sono sotto-cartelle della cartella principale “Cartelle personali”. Trattasi di oggetti MAPIFolder che poi il susseguente loop For Each MiaCart ... Next esamina e scrive nella finestra Immediata.

Fatta questa premessa, ecco la routine che provvede a trasferire nella “Posta indesiderata” il messaggio in arrivo selezionato, se – per l’appunto – non gradito o ad eliminarlo addirittura se già presente in tale cartella. Il tutto previa conferma da parte di un utente consapevole!

Sub TrasferMessInCartIndes()

  'Messaggio selezionato --> nella "Posta indesiderata"

  'o eliminato, se già era in tale cartella

  Dim Nms As NameSpace

  Set Nms = GetNamespace("MAPI")

  Dim CartIndesid As MAPIFolder

  'Esci se la cartella corrente non quella della Posta in arrivo

  If ActiveExplorer.CurrentFolder.Name <> _

     "Posta in arrivo" Then Exit Sub

  Set CartIndesid = _

  Nms.Folders("Cartelle personali").Folders("Posta indesiderata")

  Dim OlSel As Selection

  Set OlSel = ActiveExplorer.Selection

  'messaggio in arrivo, da esaminare:

  Dim MessEsam As MailItem, Mitt As String

  Set MessEsam = OlSel.Item(1) 'Ipotesi semplificativa: selezione unica

  Mitt = MessEsam.SenderName

  Dim MessIndes As MailItem, MittInPostIndes As Boolean

  'Cerca il Mittente nella cartella indesiderati

  For Each MessIndes In CartIndesid.Items

    If MessIndes.SenderName = Mitt Then

      MittInPostIndes = True

      Exit For

    End If

  Next

  Dim Msg As String

  Msg = "Indesiderato già noto." & vbLf & "Cancello questa mail?"

  If MittInPostIndes Then

    If MsgBox(Msg, vbYesNo, "") = vbYes Then MessEsam.Delete

    Exit Sub

  End If

  Msg = "Vuoi trasferire questo messaggio - mittente: " & vbLf _

     & Mitt & vbLf & "nella Posta indesiderata?"

  If MsgBox(Msg, vbInformation + vbYesNo, "") = vbYes Then

    MessEsam.Move CartIndesid

  End If

End Sub

Anche in questo caso l’estensione a più messaggi in arrivo selezionati è lasciata per esercizio (è un opportuno loop For Each… Next, banale, credo e spero).

Il punto chiave è l’ipotesi che l’utente trasferisca (anche manualmente) messaggi sgraditi nella specifica cartella. Dopo un po’ di tempo si esplorano questi … scocciatori in tale cartella per vedere se il nuovo mittente è una vecchia conoscenza. In caso positivo all’utente viene lasciata la responsabilità di eliminarlo addirittura, mentre se l’identikit fallisce all’utente si chiede se  inserirlo tra gl’indesiderati.

posted on mercoledì 24 gennaio 2007 17.49