Crittografare un messaggio Outlook
Questa è una ricetta (relativamente) elementare ma che può tornare utile fra amici e/o in piccoli gruppi desiderosi di una certa riservatezza (magari contro spyware e altre consimili diavolerie virali). Il sistema adottato si basa su due punti:
- una serie ciclica di traslitterazioni applicate successivamente ai caratteri del messaggio (un testo puro, per semplificare);
- l’inversione (completa) del testo
Non pretendo certo che il messaggio così modificato resista alle analisi automatizzate di software di cui forse si favoleggia un poco, tuttavia per un verso tali programmi non sono così diffusi, inoltre questo che presento è solo un assaggio: adottando un mix di algoritmi di varia complessità sono convinto che un file così trattato sia, di fatto, indecifrabile (a meno di non “rubare” la chiave, ovviamente.
Nota – Arcinota è poi la possibilità di adottare sistemi a doppia chiave asimmetrica, arcisicuri e standard. Ma chi li possiede veramente? I criteri artigiani cui accenno specie se adottati tra gente fidata risultano semplici e ragionevoli, proprio perché NON sono standard…
Ma veniamo al da farsi
- Aprire Outlook, poi portarsi nell’Editor Visual Basic con Alt + F11.
- Preparare una UserForm grossomodo come la seguente. Essa costituirà il minieditor per ospitare il messaggio, prima di crittarlo e spedirlo.
|
Testo del messaggio |
|
|
|
|
|
|
|
|
Amba, rabà, ciccì, coccò tre civette sul comò |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Inserisci |
|
|
|
|
|
|
|
|
|
3. Assicurarsi che la proprieà Multiline della casellona di testo centrale sia impostata a True. In tal modo verranno accettati testi di una discreta lunghezza (ma non sii dovrebbe esagerare, ne va di mezzo la pazienza richiesta dai tempi di crittazione…).
4. Creare un modulo VBA, magari dandogli un nome pregnante come “Crittograf” o simili e inserirvi le routine che stiamo per vedere.
5. Testare eventualmente tali macro e – attenzione! – salvare il (cosiddetto) VBAProject.OTM, con l’apposito comando del menu File dell’Editor VBA. E se ce ne dimentichiamo? Alla chiusura di Outlook riceveremo un richiamo in tal senso: per carità, rispondere affermativamente, altrimenti il lavoro viene perduto!
Le funzioni per crittografare
Sono riportate qui sotto, seguite dalle relative Sub di prova e da commenti essenziali.
Function StringaInversa(Str As String) As String
Dim i As Long, StrInv As String
For i = Len(Str) To 1 Step -1
StrInv = StrInv & Mid(Str, i, 1)
Next
StringaInversa = StrInv
End Function
Sub ProvaStringaInversa()
MsgBox StringaInversa("ambarabà cicci coccò tre civette sul comò " _
& "che facevano l'amore con la figlia del dottore" _
& "il dottore s'ammalò, e la figlia lo lasciò. E andò a ROMA")
End Sub
Commenti. Superflui per chi conosce le funzioni di stringa, in particolare Mid. Gli altri se la cavano ugualmente, con la Guida e lanciando, magari passo passo ProvaStringaInversa.
Function CriptStr(Str As String) As String
'Senza correzione su lunghezza di singole parole, ma
'con inversione dell'intero testo del messaggio
Dim i As Long, l As Integer, k As Integer
Dim c As String, NumAsc As Integer
Dim StrCript As String
If Str = "" Then Exit Function
Str = StringaInversa(Str)
VettChiavi = Array(43, 12, 5, 14, 21, 33, 124, 3, 5, 89, 65)
l = Len(Str): m = UBound(VettChiavi)
If k = m Then k = 0 Else k = k + 1
For i = 1 To l
NumAsc = Asc(Mid(Str, i, 1))
'MsgBox NumAsc 'Servita nel debug
NumAsc = _
NumAsc + IIf(NumAsc = 13 Or NumAsc = 10, 0, VettChiavi(k))
'Si conserva il CR o il LF
If NumAsc > 255 Then NumAsc = NumAsc - 255
c = Chr(NumAsc)
StrCript = StrCript & c
Next
CriptStr = StrCript
End Function
Sub ProvaCriptStr()
MsgBox CriptStr("Ambarabà ciccì coccò tre civette sul comò")
End Sub
Commenti. La chiamata a StrInversa palesemente registra nell’argomento Str il suo rovescio. Quindi nel VettChiavi viene riportata una serie di traslitterazioni, identiche – lo anticipo – a quelle usate in sede di decrittazione. Si tratta di numeretti che si aggiungono al codice ASCII di ciascun carattere di Str, esclusi gli a-capo (chi vuole può provare a togliere queste eccezioni…), dopo di che in StrCript l’operatore di concatenamento & accoda i caratteri man mano crittati. Cruciale è l’istruzione If NumAsc > 255 Then NumAsc = NumAsc – 255, che qualora la traslitterazione porti fuori del numero massimo di codici ASCII (255) provvede, ciclicamente, ad aggiustare il tiro riportandolo nei primi della serie ASCII stessa.
La macro crittografante
Chiama in gioco la nostra UserForm1.
Sub InviaMessCripto()
'Tramite UserForm1 e senza correzione su lunghezza di singole
'parole ma con inversione dell'intero testo del messaggio
Dim MioMess As MailItem, TestoMess As String
Load UserForm1
With UserForm1
.TextBox1.Text = ""
.Show
TestoMess = .TextBox1.Text
'.Hide 'NON serve, previsto nell'evento Click del pulsante
End With
Unload UserForm1
If MsgBox("Vuoi crittografare?", vbYesNo) = vbYes Then
TestoMess = CriptStr(TestoMess)
End If
Set MioMess = Application.CreateItem(olMailItem)
With MioMess
.To = "giannigiac@tin.it" 'A me stesso (è una prova)
.Subject = "Messaggio crittografato!"
.Body = TestoMess
.Display
End With
Set MioMess = Nothing
End Sub
Stavolta mi astengo da commenti, ritenendoli a questo punto superflui.
Nota - E poi tutti i nostri visitatori amano – persino troppo, per un ambiente Office, ove spesso se ne può fare a meno (specie in Excel) – le UserForm e le sfruttano abilmente.
Doveroso, infine, ma sempre senza inutili commenti, il codice racchiuso nella UserForm:
Private Sub CommandButton1_Click()
If TextBox1.Text = "" Then
MsgBox "DEVI inserire qualcosa...", vbCritical, "Attenzione!"
TextBox1.SetFocus 'Focalizza la casella di testo
Else
Me.Hide
End If
End Sub
Private Sub UserForm_Initialize()
With TextBox1
.Text = "" 'In realtà serve poco...
.SetFocus 'Focalizza la casella di testo
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = 1
End Sub
Il codice de-crittografante
Lo riporto doverosamente ma senza altri commenti, a questo punto, superflui.
Function DecriptStr(Str As String) As String
'Senza correzione su lunghezza di singole parole, ma
'con inversione dell'intero testo del messaggio
Dim i As Long, l As Integer, k As Integer
Dim c As String, NumAsc As Integer
Dim StrDecript As String
If Str = "" Then Exit Function
Str = StringaInversa(Str)
VettChiavi = Array(43, 12, 5, 14, 21, 33, 124, 3, 5, 89, 65)
l = Len(Str): m = UBound(VettChiavi)
If k = m Then k = 0 Else k = k + 1
For i = 1 To l
NumAsc = Asc(Mid(Str, i, 1))
NumAsc = NumAsc - IIf(NumAsc = 13 Or NumAsc = 10, 0, VettChiavi(k))
'mantieni il CR che ora è = 10 (diosaperché)
If NumAsc < 0 Then NumAsc = NumAsc + 255
c = Chr(NumAsc)
StrDecript = StrDecript & c
Next
DecriptStr = StrDecript
End Function
Sub ProvaDecriptStr()
Dim MiaStr As String
MiaStr = CriptStr("Ambarabà ciccì coccò tre civette sul comò")
MsgBox DecriptStr(MiaStr)
End Sub
Dimenticavo: va da sé, ma dirlo non guasta, che i vari partner debbono possedere le macro sopra riportate e che, in caso di aggiornamento delle chiavi debbono, scrupolosamente, sincronizzarle personalmente nelle istruzioni VettChiavi = Array(. . . ) presenti in entrambe le Sub, crittante e decrittante. L’inconveniente dovuto a distrazioni e simili si può ovviare con modalità che lascio all’inventiva degl’interessati…
?>