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

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