Crittografia personale avanzata di fogli Excel (con un criterio ORIGINALE)

Crittografia personale avanzata di fogli Excel

Nota bene. La precedente versione conteneva un errore (di distrazione) al quale ho messo una pezza (nella Sub CriptStr).

In questo sito devo aver già proposto procedimenti elementari di crittografia di documenti vari (o di messaggi e-mail), senza pretesa che fossero impenetrabili ai sofisticati mezzi di decifratura automatica ma comunque validi per creare una barriera perlomeno contro i ficcanaso meno smaliziati.

Quello che ora oso proporre ai visitatori più esperti e fantasiosi è un algoritmo crittografico elementare-ma- non-troppo, grazie all’aggiunta della LUNGHEZZA della stringa più l'INVERSIONE della stringa, ma soprattutto con la traduzione di CIFRE in altre CIFRE. nelle celle puramente numeriche. Questa distinzione fa sì che i valori numerici si possano decodificare solo conoscendo la pur semplice chiave, che è diversa da quella utilizzata coi dati alfanumerici.

Non è finita! Si usano tre vettori di numeri di translitterazione, applicati via via a 1/3, 1/3 e 1/3 delle celle criptande. In tal modo si riduce di un terzo la dimensione dei dati da criptare, rendendo ancora più ardua la decifratura automatica (tramite algoritmi più o meno astuti, basati pur sempre sulla frequenza dei caratteri in una certa lingua e sulla lunghezza della chiave).

Sperimentare le macro (descritte più avanti)

Per sperimentare il procedimento, si prenda un foglio di lavoro Excel e in un primo intervallo a piacere si immettano i dati alfanumerici seguenti (o altri meno strambi):

In un altro intervallo, sempre arbitrario, si inseriscano valori numerici, eventualmente formattati:

Infine un terzo intervallo, diciamo E7:F10 per fissare le idee, come il seguente potrebbe servire a sfruttare le funzione personali di crittazione / decrittazione (descritte in dettaglio più avanti):

Conviene subito anticipare che il dato di partenza (“ambarabà”) è in E8, mentre nella altre celle abbiamo:

E9=criptaDecripta(E8;VERO)

F9=criptaDecripta(E9;FALSO)

E10 =criptaDecripta(E9;FALSO)

F10=criptaDecripta(F9;VERO)

I buoni intenditori cui mi rivolgo comprendono o, almeno, intuiscono che CriptaDecripta svolge entrambi i mestieri, a seconda del secondo argomento, ossia cripta se questo è VERO, decripta se è FALSO.

Il codice macro, finalmente

Lo fornisco come ricetta, pertanto corredata di scarsi commenti, da inserire in un qualche modulo CriptaDecripta.vb (*). Premetto solo che le macro alla fine utilizzabili – ad esempio collegandole ad altrettanti pulsanti (classici) di Excel – sono le seguenti, evidenziate in grassetto nel listato:

·         CriptaCellaAttiva, per cifrare la (singola) cella corrente

·         DecriptaCellaAttiva, per decifrare la (singola) cella corrente

·         CriptaFoglio, cifra tutte le celle del foglio

•   DeCriptaFoglio, decifra l’intero foglio

Ma ecco il listato.

'Variabili definite a livello modulo

Dim Swcript As Boolean, Swcriptot As Boolean

Dim k As Integer 'Indice sempre-avanti

Function CriptStr(ByVal Str As String, Cript As Boolean, EstNum As Boolean, IndArr As Integer) As String
  If Str = "" Then Exit Function
  Dim i As Integer, L As Integer, m As Integer
  'Trattamento cifre numeriche: restano TALI!
  Dim Correz As Integer, Car As String
  L = Len(Str)
  If L = 1 Then
    If Cript Then
      CriptStr = IIf(Str < 9, Str + 1, 0)
    Else
      CriptStr = IIf(Str > 0, Str - 1, 9)
    End If
    Exit Function
  End If
  If EstNum Then
      For i = 1 To L
        k = k + 1 'La translitter.ne delle cifre
        'è sistematicamente progressiva (un criterio come un altro...)
        Correz = k Mod 9 - 1
        Car = Mid(Str, i, 1)
        If Not (Car = "," Or Car = ".") Then
          If Cript Then
            Car = Car + Correz
            If Car >= 9 Then Car = Car - 9
          Else
            Car = Car - Correz
            If Car <= 0 Then Car = Car + 9
          End If
        End If
        Mid(Str, i, 1) = Car
      Next
    CriptStr = Str
    Exit Function
  End If
 Dim NumAsc As Integer
  VettChiavi = Array(Array(43, 12, 5, 14, 21, 33, 124, 3, 5, 89, 65), _
                     Array(35, 27, 7, 5, 45, 33, 32, 47, 65, 33, 42), _
                     Array(24, 12, 75, 48, 12, 68, 4, 5, 12, 35, 69))
  m = UBound(VettChiavi(IndArr))
  If k >= m Then k = 0 Else k = k + 1
  For i = 1 To L
    Correz = VettChiavi(IndArr)(k) + (L Mod 256)
    If Not Cript Then Correz = -Correz
    NumAsc = Asc(Mid(Str, i, 1)) + Correz
    If Cript Then
      If NumAsc > 255 Then NumAsc = NumAsc - 255
    Else
      If NumAsc < 0 Then NumAsc = NumAsc + 255
    End If
    Car = Chr(NumAsc)
    Mid(Str, i, 1) = Car
    If k = m Then k = 0 Else k = k + 1
  Next
  CriptStr = Str
End Function

Sub CriptaCellaAttiva()

  If Swcript Then Exit Sub

  Dim strModif As String, EstN As Boolean

  k = 0

  EstN = IsNumber(ActiveCell)

  With ActiveCell

    If IsEmpty(.Value) Then Exit Sub

    'qui si prende solo il primo dei 3 array

    strModif = _

    CriptStr(.Formula, True, EstN, IndArr:=0)

    strModif = StringInvert(strModif)

    If Not EstN Then .Formula = "*" & strModif

    'aggiunge un * iniziale per evitare la @

    .Formula = strModif

  End With

  Swcript = Not Swcript

End Sub

Sub DecriptaCellaAttiva()

  If Not Swcript Then Exit Sub

  Dim L As Integer, strModif As String, EstN As Boolean

  k = 0

  With ActiveCell

    strModif = .Formula

    'toglie anzitutto l'eventuale * iniziale

    If Left(strModif, 1) = "*" Then

      L = Len(strModif)

      strModif = Left(strModif, L - 1)

    End If

    strModif = StringInvert(strModif)

    .Formula = strModif

    EstN = IsNumber(ActiveCell)

    .Formula = CriptStr(strModif, False, EstN, IndArr:=0)

  End With

  Swcript = Not Swcript

End Sub

'Seguono varie funzioni base

Function StringInvert(MiaStr As String)

  Dim Str As String

  For i = Len(MiaStr) To 1 Step -1

    Str = Str & Mid(MiaStr, i, 1)

  Next

  StringInvert = Str

End Function

Sub CriptaFoglio()

  If Swcriptot Then Exit Sub

  Application.ScreenUpdating = False

  Dim CelleVive As Range, MiaC As Range, strModif As String

  Dim VettPrimoCar, iPrimoCar As Integer, LimSup As Integer

  VettPrimoCar = Array("*", "#", "@", "%")

  LimSup = UBound(VettPrimoCar)

  Dim EstN As Boolean, NumCelleFraz As Integer, _

      indCella As Integer, IndArray As Integer

  k = 0

  Set CelleVive = _

  Range(Cells(1, 1), Cells(1, 1).SpecialCells(xlLastCell))

  NumCelleFraz = CelleVive.Count \ 3

  For Each MiaC In CelleVive

      indCella = indCella + 1

      If Not IsEmpty(MiaC) Then

      EstN = IsNumber(MiaC)

      Select Case indCella

        Case 1 To NumCelleFraz

          IndArray = 0

        Case NumCelleFraz To NumCelleFraz * 2

          IndArray = 1

        Case Else

          IndArray = 2

      End Select

      strModif = CriptStr(MiaC.Formula, True, EstN, IndArray)

      strModif = StringInvert(strModif)

      If Not EstN Then

      'aggiunge un carattere iniziale a caso nelle celle non numeriche

        iPrimoCar = LimSup * Rnd

        MiaC.Formula = VettPrimoCar(iPrimoCar) & strModif

      Else

        MiaC.Formula = strModif

      End If

    End If

  Next

  Swcriptot = Not Swcriptot

End Sub

Sub DecriptaFoglio()

  If Not Swcriptot Then Exit Sub

  Application.ScreenUpdating = False

  Dim CelleVive As Range, MiaC As Range, _

  L As Integer, strModif As String

  Dim PrimoCar As String

  VettPrimoCar = Array("*", "#", "@", "%")

  Dim EstN As Boolean, NumCelleFraz As Integer, _

  indCella As Integer, IndArray As Integer

  k = 0

  Set CelleVive = _

  Range(Cells(1, 1), Cells(1, 1).SpecialCells(xlLastCell))

  NumCelleFraz = CelleVive.Count \ 3

  For Each MiaC In CelleVive

      indCella = indCella + 1

      If Not IsEmpty(MiaC) Then

      'toglie anzitutto l'eventuale carattere iniziale extra

      Dim i As Integer

      PrimoCar = Left(MiaC, 1)

      L = Len(MiaC.Formula)

      For i = 0 To UBound(VettPrimoCar)

        If PrimoCar = VettPrimoCar(i) Then

           MiaC.Formula = Right(MiaC.Formula, L - 1)

           Exit For

        End If

      Next i

      strModif = MiaC.Formula

      EstN = IsNumber(MiaC)

      Select Case indCella

        Case 1 To NumCelleFraz

          IndArray = 0

        Case NumCelleFraz To NumCelleFraz * 2

          IndArray = 1

        Case Else

          IndArray = 2

      End Select

      strModif = StringInvert(strModif)

      MiaC.Formula = CriptStr(strModif, False, EstN, IndArray)

    End If

  Next MiaC

  Swcriptot = Not Swcriptot

End Sub

Function IsFormula(Cella As Range) As Boolean

  'N.B. Cella.Value o Cella NON svelerebbe l'=

  'COMUNQUE SERVE A POCO: C'E' HasFormula!

  IsFormula = (Left(Cella.Formula, 1) = "=")

End Function

Function IsNumber(Cella As Range) As Boolean

  If IsEmpty(Cella) Or Not IsNumeric(Cella) Then Exit Function 'Con valore False

  If Not Cella.HasFormula Then IsNumber = True

End Function

Spiacente deludere ma, ripeto, non mi va di fornire delucidazioni dettagliate. D’altronde i più esperti possono con pazienza trovarle da soli (un utile esercizio, magari foriero di migliorie e personalizzazioni), mentre gli altri se copiano pazientemente tali macro in un modulo possono sperimentarne la validità.

In pratica tutti constateranno che agendo sui predetti pulsanti i dati vengono crittati e, alternativamente, decrittati restituendo regolarmente gli originali, con una basilare differenza: quelli alfanumerici – ovvero, si badi bene, anche dati come AZ123 o formule tipo =SOMMA(...) sono cifrati in forma di caratteri strani, quelli numerici (costanti) sono tradotti in altri numeri. A costo di tediare insisto nel dire che se, ad esempio, nel secondo intervallo indicato in apertura si ottengono sempre cifre numeriche, è molto arduo anzi a mio avviso impossibile risalire all’originale senza conoscere la particolare chiave applicata ai numeri.

Posso sbagliare ma per quel che se ne sa i normali, anche sofisticatissimi software di decrittazione automatica, non prevedono questa distinzione pertanto potrebbero anche ricavare trionfalmente gli originali “amba”, “rabà”, “ciccì”, “coccò” ma di fronte a un 5678 che in origine era 1234 restituirebbero buffe stringhe come un QI?; o altra criptica stringa.

Un’ultima notazione, relativa al terzo intervallo E7:F10 proposto in apertura. In un primo tempo avevo pensato di sfruttare la funzione StrCript(;VERO/FALSO;0, IndArray) usata nelle macro testé elencate. Poi mi sono accorto che nascevano effetti imprevisti quanto indesiderati, a causa del RICALCOLO. Trattandosi di un puro sfizio didattico, potevo rinunciare, comunque ho ripiegato wsulla seguente alternativa:

Function CriptaDecripta(Str As String, Cript As Boolean) As String

  'Usata solo nelle celle del foglio, perché CriptDecript darebbe ERRORE!

  Dim i As Integer, k As Integer, L As Integer, _

  m As Integer, Correz As Integer, C As String, NumAsc As Integer

  If Str = "" Then Exit Function

  'Str = StringInvert(Str) 'Dà ERRORI! NMON va inserito qui...

  VettChiavi = Array(43, 12, 5, 14, 21, 33, 124, 3, 5, 89, 65)

  L = Len(Str): m = UBound(VettChiavi)

  Dim CriptStr As String 'Variabile locale: non confondere con l'omonima funzione

  For i = 1 To L

    Correz = VettChiavi(k) + L

    If Not Cript Then Correz = -Correz

    NumAsc = Asc(Mid(Str, i, 1)) + Correz

    If Cript Then

      If NumAsc > 255 Then NumAsc = NumAsc - 255

    Else

      If NumAsc < 0 Then NumAsc = NumAsc + 255

    End If

    C = Chr(NumAsc)

    CriptStr = CriptStr & C

    If k = m Then k = 0 Else k = k + 1

  Next

  CriptaDecripta = CriptStr

End Function

Conclusione spicciola, ma importante

Cosa c’è di più prezioso in un foglio di calcolo? Ma, santo cielo!, i NUMERI. Renderli indecifrabili è basilare in Excel. Infatti a che serve ricostruire titoli e intestazioni? E a che giova scoprire la più strane funzioni se poi i numeri cui queste sono applicate sono fasulli e, il più delle volte, tali funzioni danno errori tipo #VALORE! O (raramente) magari numeri del tutto errati?

Questo criterio può valere anche in un documento Word? Volendo sì, se presenta un buon numero di dati sensibili. Con un’eccezione. Se il numero, come occorre in documenti legali, deve essere affiancato da un’espressione in lettere – esempio: 1.234 (milleduecentotrentaquattro) – il marchingegno non funziona (a meno di non prevedere un’ulteriore codifica a parte per le stringhe tipo milleduecentotrentaquattro, ma la cosa si complica anzichenò e solo a fronte di un incarico remunerato mi impegnerei nella tediosa ancorché non impossibile impresa.?

Per scaricare il modello:

http://www.giannigiaccaglini.it/download/CriptografLaborAv.xls

Buon divertimento.

posted on lunedì 26 gennaio 2009 15.19