Protection logicielle – Cryptage et décryptage d'une chaîne de caractères

J’ai été amené a installer une protection logicielle sur un programme écrit en Visual Basic (VB express 2010) par un de mes collègues.
Le système fonctionne de la manière suivante:
Hubert est la personne qui commercialise le logiciel
Louis est l’acquéreur potentiel
Louis télécharge sur le site de Hubert le pack logiciel. Il lance la procédure de Setup et sur son bureau 3 raccourcis pointant sur les applications suivantes sont installés.
Le formulaire d’enregistrement du logiciel

Louis remplit les champs du formulaire puis clique sur Envoyer. Hubert reçoit un mail contenant toutes les informations saisies par Louis mais en sus Louis a à son insu lancé une routine permettant de récupérer le numéro de série de son disque dur, Hubert est maintenant en possession de cette information.
Hubert lance la moulinette Excel (Macro VBA) qui va générer la clef. Un XOR et des opérations complémentaires de cryptage vont être effectués avec une chaîne de caractères connue de Hubert uniquement et écrite en dur dans la routine VBA excel.

Dès le règlement effectué Hubert transmet à Louis la clef de déverrouillage
Louis ouvre le formulaire qui lui permettra de déverrouiller le logiciel.

Quand il clique sur Valider on récupère le N° de série du disque dur de la machine puis on vérifie que la clef saisie est valide exécutant une routine VBA qui exécutera les opérations dans l’ordre inverse de ce qui a été fait dans la routine VBA excel lancée par Hubert.
On s’assure alors que le N° de série du dique dur sur lequel doit être installé l’application finale est bien identique à ce qui a été transmis par Mail à Hubert.
Dans l’affirmative on écrit une clef dans la base de registres qui permettra d’utiliser le logiciel.
A chaque lancement de l’application finale cette clef de registre est lue et autorise ou non son exécution .
VBA Excel

Option Explicit
Private Sub CommandButton1_Click()  '     **********CRYPTAGE de la clef**********
Dim nbcar As Integer
Dim nbchiffres As Integer
Dim clefcryptee As String
Dim contenu As String
Dim extraction1 As String
Dim extraction2 As String
Dim clef As String
Dim hex1 As String
Dim n As Integer
Dim c As Integer
Dim masque As Integer
    'Clef de cryptage
    clef = "Paraphrase servant de clef de cryptage"
    'On récupère le contenu de la textbox
    contenu = Tb1.Value
    'on compte le nb de caractères
    nbcar = Len(contenu)
    'récupération du code ascii de chaque chr
        For n = 1 To nbcar
            extraction1 = Asc(Mid(clef, n, 1))
            extraction2 = Asc(Mid(contenu, n, 1))
            masque = extraction1 Xor extraction2
            hex1 = Hex(masque)
            If Len(hex1) = 1 Then
                hex1 = "0" & hex1
            End If
            clefcryptee = clefcryptee + hex1 + "-"
        Next n
	'Affichage clef cryptée dans textbox2
    Tb2.Text = Left(clefcryptee, Len(clefcryptee) - 1)
End Sub
Private Sub CommandButton2_Click() '     **********DECRYPTAGE de la clef**********
Dim clef As String
Dim extraction As String
Dim extractplf As String
Dim contenu As String
Dim n As Integer
Dim i As Integer
Dim c As Integer
Dim position As Integer
Dim caractere As String
Dim lettre As String
Dim clef_decryptee As String
Dim resultat As String
Dim tabl(50, 4)
i = 0
c = 1
'Clef de cryptage
clef = "Paraphrase servant de clef de cryptage"
contenu = Tb2.Text
For n = 1 To Len(contenu)
'On va extraire un a un les caracteres de la chaine qui a été cryptée
extraction = Mid(contenu, n, 1)
If extraction <> "-" Then
    caractere = caractere + extraction
End If
If extraction = "-" Then
    tabl(i, 0) = caractere
    tabl(i, 1) = hex_to_dec(caractere)
    tabl(i, 2) = Asc(Mid(clef, c, 1))
    tabl(i, 3) = Chr(tabl(i, 1) Xor tabl(i, 2))
    resultat = resultat + tabl(i, 3)
    i = i + 1
    c = c + 1
    caractere = ""
End If
Next n
    tabl(i, 0) = caractere
    tabl(i, 1) = hex_to_dec(caractere)
    tabl(i, 2) = Asc(Mid(clef, c, 1))
    tabl(i, 3) = Chr(tabl(i, 1) Xor tabl(i, 2))
    resultat = resultat + tabl(i, 3)
    TextBox1.Text = resultat
End Sub
Function hex_to_dec(chaine)
    'Conversion de 00 à FF en décimal
    Dim ch1 As String
    Dim ch2 As String
    Dim hexa As String
    Dim n, D1, D2 As Integer
    'on extrait le chr de droite de la chaine
    ch1 = Right(chaine, 1)
    If IsNumeric(ch1) Then
        D1 = CInt(ch1)
        Else 'Il s'agit de A,B,C,D,E ou F - ASCII 65 à 70
        D1 = Asc(ch1) - 55
    End If
    'on extrait le chr de gauche de la chaine
    ch2 = Left(chaine, 1)
    If IsNumeric(ch2) Then
        D2 = CInt(ch2) * 16
        Else 'Il s'agit de A,B,C,D,E ou F - ASCII 65 à 70
        D2 = (Asc(ch2) - 55) * 16
    End If
    hex_to_dec = D1 + D2
End Function

Option Explicit

Private Sub CommandButton1_Click() ' **********CRYPTAGE de la clef**********

Dim nbcar As Integer

Dim nbchiffres As Integer

Dim clefcryptee As String

Dim contenu As String

Dim extraction1 As String

Dim extraction2 As String

Dim clef As String

Dim hex1 As String

Dim n As Integer

Dim c As Integer

Dim masque As Integer

'Clef de cryptage

clef = "Paraphrase servant de clef de cryptage"

'On récupère le contenu de la textbox

contenu = Tb1.Value

'on compte le nb de caractères

nbcar = Len(contenu)

'récupération du code ascii de chaque chr

For n = 1 To nbcar

extraction1 = Asc(Mid(clef, n, 1))

extraction2 = Asc(Mid(contenu, n, 1))

masque = extraction1 Xor extraction2

hex1 = Hex(masque)

If Len(hex1) = 1 Then

hex1 = "0" & hex1

End If

clefcryptee = clefcryptee + hex1 + "-"

Next n

'Affichage clef cryptée dans textbox2

Tb2.Text = Left(clefcryptee, Len(clefcryptee) - 1)

End Sub

Private Sub CommandButton2_Click() ' **********DECRYPTAGE de la clef**********

Dim clef As String

Dim extraction As String

Dim extractplf As String

Dim contenu As String

Dim n As Integer

Dim i As Integer

Dim c As Integer

Dim position As Integer

Dim caractere As String

Dim lettre As String

Dim clef_decryptee As String

Dim resultat As String

Dim tabl(50, 4)

i = 0

c = 1

'Clef de cryptage

clef = "Paraphrase servant de clef de cryptage"

contenu = Tb2.Text

For n = 1 To Len(contenu)

'On va extraire un a un les caracteres de la chaine qui a été cryptée

extraction = Mid(contenu, n, 1)

If extraction <> "-" Then

caractere = caractere + extraction

End If

If extraction = "-" Then

tabl(i, 0) = caractere

tabl(i, 1) = hex_to_dec(caractere)

tabl(i, 2) = Asc(Mid(clef, c, 1))

tabl(i, 3) = Chr(tabl(i, 1) Xor tabl(i, 2))

resultat = resultat + tabl(i, 3)

i = i + 1

c = c + 1

caractere = ""

End If

Next n

tabl(i, 0) = caractere

tabl(i, 1) = hex_to_dec(caractere)

tabl(i, 2) = Asc(Mid(clef, c, 1))

tabl(i, 3) = Chr(tabl(i, 1) Xor tabl(i, 2))

resultat = resultat + tabl(i, 3)

TextBox1.Text = resultat

End Sub

Function hex_to_dec(chaine)

'Conversion de 00 à FF en décimal

Dim ch1 As String

Dim ch2 As String

Dim hexa As String

Dim n, D1, D2 As Integer

'on extrait le chr de droite de la chaine

ch1 = Right(chaine, 1)

If IsNumeric(ch1) Then

D1 = CInt(ch1)

Else 'Il s'agit de A,B,C,D,E ou F - ASCII 65 à 70

D1 = Asc(ch1) - 55

End If

'on extrait le chr de gauche de la chaine

ch2 = Left(chaine, 1)

If IsNumeric(ch2) Then

D2 = CInt(ch2) * 16

Else 'Il s'agit de A,B,C,D,E ou F - ASCII 65 à 70

D2 = (Asc(ch2) - 55) * 16

End If

hex_to_dec = D1 + D2

End Function

A noter que la partie “Décryptage sert uniquement utilisée pour décrypter la clef et vérifier que tout est OK. C’est ce code qu’il faudra très légèrement remanier pour l’intégrer dans le formulaire de déverrouillage du logiciel écrit lui avec VB express 2010.
Je m’en tiens la.pour l’instant et pour ce qui est du code VB Express 2010 je diffuserai le code ultérieurement

kergoaler.fr

Informatique et domotique – Blog maintenu par Patrice WITTE

Protection logicielle – Cryptage et décryptage d'une chaîne de caractères