Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Nouveau membre du Club
    Homme Profil pro
    Conseil - Consultant en systèmes d'information
    Inscrit en
    juillet 2017
    Messages
    31
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Conseil - Consultant en systèmes d'information

    Informations forums :
    Inscription : juillet 2017
    Messages : 31
    Points : 28
    Points
    28
    Par défaut date limite d'utilisation pour une application access
    Bonjour,

    Bonjour,

    Je dois proposer une démo d'une application existante à un client, ou dans une autre cas, que le client paye un loyer pour l'utilisation de l'application.

    Je souahiterais qu'il puisse l'utiliser pendant une durée de temps limitée, par exemple jusqu'au 1er février, puis qu'elle soit bloquée.

    La première solution qui m'est venue à l'esprit serait d'ajouter un test de la date sur le forumulaire d'accès à la base, mais ce n'est pas pratique pour modifier cette date par exemple, chaque mois si le client paye mensuellement.

    Une deuxième solution à laquelle j'ai pensée serait de créer une page sur un site qui contienne seulement la date limite d'utilisation.

    Au moment de l'ouverture de la base on scrape la page (il me semble que c'est possible), puis on récupère la donnée et ensuite on comprare cette date avec la date courante pour donner accès ou non à l'application.

    Est-ce que vous voyez des solutions plus simples?

  2. #2
    Rédacteur/Modérateur

    Avatar de Jean-Philippe André
    Homme Profil pro
    Developpeur VBA, C# et VB.Net =]
    Inscrit en
    juillet 2007
    Messages
    13 835
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Canada

    Informations professionnelles :
    Activité : Developpeur VBA, C# et VB.Net =]
    Secteur : Finance

    Informations forums :
    Inscription : juillet 2007
    Messages : 13 835
    Points : 31 646
    Points
    31 646
    Par défaut
    Bonjour,

    la mise en place d'un blocage si non confirmation d'un abonnement est une des fonctionnalités les plus complexes à gérer selon moi.

    Le degré de blocage est toujours inhérent a la capacité du client de chercher à te court-circuiter.

    Un client sans aucune compétence n'ira pas chercher dans les tables.
    Un client sans technicien n'ira pas chercher dans les fichiers plats, en clair.
    Un client sans temps à consacrer n'ira pas chercher à reverser ton encodage…

    Une clé en hexadecimal c'est le mieux que j'ai réussi à utiliser fut un moment...
    Cycle de vie d'un bon programme :
    1/ ca fonctionne 2/ ca s'optimise 3/ ca se refactorise

    Pas de question technique par MP, je ne réponds pas

    Apprendre à programmer avec Access 2016 et Access 2019

    Pensez à consulter la FAQ Excel et la FAQ Access

    Derniers tutos
    Excel et les paramètres régionaux
    Les fichiers Excel binaires : xlsb,

    Autres tutos

  3. #3
    Membre éclairé Avatar de Ric500
    Homme Profil pro
    Développeur informatique
    Inscrit en
    août 2004
    Messages
    743
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : août 2004
    Messages : 743
    Points : 885
    Points
    885
    Par défaut date limite d'utilisation pour une application access
    Bonjour,

    Quant à moi j'utilise avec bonheur ce code provenant d'Arkham46: il permet d'octroyer une clé de licence à un prospect qu'il saisit dans une table paramètres, par exemple. La génération de clés se fait via un module qui procure une clé cryptée (ou pas) qui donne une durée de vie à l'utilisation de l'application, qui du coup peut être pleinement fonctionnelle. Tu peux générer des clés temporaires ou définitives selon ton besoin (après essai, tu fournis une clé définitive).

    Ci-après le module de Thierry, enjoy

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    Option Compare Database
     
    Option Explicit
    Option Private Module
    '----------------------------------------------------
    ' Exemple de génération de clé HEXA (0 à 9 et A à F)
    '----------------------------------------------------
    ' Pour personnaliser votre clé, modifier la valeur de gModulo
    '     et des multiplicateur dans la fonction GetMult
    ' Conservez la fonction GenerateKey hors de l'application
    '
    '----------------------------------------------------
     
    ' Modulo : Le Checksum doit être multiple de ce nombre
    ' Ce nombre doit être inférieur à la somme des multiplicateur * 15
    Private Const gModulo = 480
     
    ' Clé de cryptage
    Private Const CLEF As String = "A45RGT5FER6745GHTOGFSDOPK56453235K"
     
    ' Nombre d'itérations de la fonction maximum
    Private Const NBROTATIONSMAX       As Long = 13
     
    ' Valeurs possibles
    Private Const gValues = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
     
    Function DaysLeftK(sKey)
        DaysLeftK = CLng("&H" & Mid(sKey, 3, Mid(sKey, 2, 1))) - CLng(DateValue(Now))
    End Function
     
     
    ' Multiplicateurs pour calcul du checksum
    Private Function GetMult(pNum As Integer) As Integer
        Select Case pNum
            Case 1: GetMult = 10
            Case 2: GetMult = 13
            Case 3: GetMult = 9
            Case 4: GetMult = 11
            Case 5: GetMult = 14
            Case 6: GetMult = 12
            Case 7: GetMult = 3
            Case 8: GetMult = 2
            Case 9: GetMult = 7
            Case 10: GetMult = 6
            Case 11: GetMult = 5
            Case 12: GetMult = 4
            Case 13: GetMult = 8
            Case 14: GetMult = 15
            Case 15: GetMult = 1 ' Doit être égale à 1
        End Select
    End Function
     
    ' Vérifie si la clé est correcte
    ' Si la clé a été générée avec une date, vérifie si pValidDate est inférieur ou égale à cette date
    Public Function CheckKey(ByVal sKey As String, Optional pValidDate As Date) As Boolean
        On Error GoTo gestion_erreurs
        Dim lDate As Date
        ' Clé vide invalide
        If Len(sKey) = 0 Then
            CheckKey = False
            Exit Function
        End If
        ' Calcul du checksum
        If (GetCheckSum(sKey) Mod gModulo) = 0 Then
            ' Vérifie si la date est valide
            ' La date commence au troisième caractère si le premier caractère est D,
            '    sa longueur est écrite dans le deuxième caractère
            If Mid(sKey, 1, 1) = "D" Then ' On a codé une date dans la clé
               If pValidDate = Format("00:00:00") Then pValidDate = Now ' Vérifie à la date du jour par défaut
               If CLng("&H" & Mid(sKey, 3, Mid(sKey, 2, 1))) >= CLng(DateValue(pValidDate)) Then
                    CheckKey = True
               End If
            Else
                CheckKey = True
            End If
        End If
    Exit Function
    gestion_erreurs:
    CheckKey = False
    End Function
     
    ' Calcul le checksum
    Private Function GetCheckSum(sKey As String) As Long
        On Error GoTo gestion_erreurs
        Dim lChecksum As Long
        Dim lCpt As Integer
        lChecksum = 0
        For lCpt = 1 To Len(sKey)
            lChecksum = lChecksum + (GetMult(lCpt) * CLng("&h" & Mid(sKey, lCpt, 1)))
        Next
        GetCheckSum = lChecksum
        Exit Function
    gestion_erreurs:
        GetCheckSum = -1
    End Function
     
    ' Génère une clé
    ' Si pDate est précisée, la clé inclue cette date
    Public Function GenerateKey(Optional pDate As Date) As String
    Dim LKey As String
    Dim lLastNumber As Integer
    Dim lCpt As Integer
    Dim lModulus As Long
    Dim lNextNumber As Long
    Dim lCptFirst As Integer
     
    Do
        ' Initialise la clé
        LKey = ""
        If pDate = Format("00:00:00") Then
            ' Date non précisée
            ' Premier caractère = A
            LKey = "A"
            ' On commence la génération au deuxième caractère
            lCptFirst = 2
        Else
            ' Date précisée
            ' Premier caractère = D
            LKey = "D"
            ' On ajoute la taille de la date puis la date en Hexa
            LKey = LKey & CStr(Len(CStr(Hex(DateValue(pDate))))) & CStr(Hex(DateValue(pDate)))
            ' On poursuit la génération au caractère suivant la date
            lCptFirst = Len(LKey) + 1
        End If
        ' Jusqu'au caractère 12, génère des chiffres hexa aléatoires
        For lCpt = lCptFirst To 12
            LKey = LKey & CStr(Hex(15 * Rnd))
        Next
        ' Les trois derniers caractères sont calculés pour essayer d'atteindre
        '  un checksum correct (multiple de gModulo)
        For lCpt = 13 To 15
            lModulus = gModulo - (GetCheckSum(LKey) Mod gModulo)
            lNextNumber = lModulus \ GetMult(lCpt)
            If lNextNumber > 15 Then ' pas de chiffre supérieur à 15 (F en hexa)
                lNextNumber = 15
            End If
            LKey = LKey & CStr(Hex(lNextNumber))
        Next
    Loop Until (GetCheckSum(LKey) Mod gModulo) = 0  'On boucle tant qu'on a pas trouvé une clé valide
     
    GenerateKey = LKey
    End Function
     
    Public Function Crypter(ByVal pChaine As String)
    '---------------------------------------------------------------------------------------
    ' Procedure : Crypter
    ' Créée le  : lundi 18 juil 2005 18:51
    ' Auteur    : Maxence HUBICHE
    ' Site      : http://mhubiche.developpez.com
    ' Objet     : Crypter la chaîne en fonction d'une clef et de la méthode
    '               de Vigenère
    ' Adapaté par :
    ' Thierry GASPERMENT (Arkham46) Cryptage avec valeurs possibles
    '---------------------------------------------------------------------------------------
    ' Le chaine pChaine doit être composée de caractères présents dans gValues
    '---------------------------------------------------------------------------------------
     
        Dim sLettres    As String
        Dim lCompteur   As Long
        Dim lLongueur   As Long
        Dim lBoucle     As Long
        Dim lLenValues  As Long
        'Définition de la longueur de la chaîne à crypter et de la chaîne de résultat
        lLongueur = Len(pChaine)
        sLettres = String(lLongueur, Chr(0))
        lLenValues = Len(gValues)
        'Boucler en fonction du nombre de rotations attendues
        For lBoucle = 1 To NBROTATIONSMAX
            'boucler pour chaque caractère de la chaîne initiale
            For lCompteur = 1 To lLongueur
                If InStr(gValues, Mid(pChaine, lCompteur, 1)) <> 0 Then
                    Mid(sLettres, lCompteur, 1) = Mid(gValues, (InStr(gValues, Mid(pChaine, lCompteur, 1)) + _
                        (InStr(gValues, Mid(CLEF, (lCompteur Mod Len(CLEF)) + 1, 1)) * lLongueur)) Mod lLenValues + 1)
                Else
                    Mid(sLettres, lCompteur, 1) = Mid(pChaine, lCompteur, 1)
                End If
            'recommencer
            Next
            'réaffecter la chaîne à crypter par le résultat trouvé pour pouvoir recommencer une itération
            pChaine = sLettres
        'Nouvelle itération
        Next
        'Renvoyer le résultat final
        Crypter = sLettres
    End Function
     
    Public Function Decrypter(ByVal pChaine As String)
    '---------------------------------------------------------------------------------------
    ' Procedure : Decrypter
    ' Créée le  : 25 juin 2005 18:51
    ' Auteur    : Thierry GASPERMENT
    ' Site      : http://arkham46.developpez.com
    ' Objet     : Decrypter la chaîne en fonction d'une clef et de la méthode
    '               de Vigenère
    '---------------------------------------------------------------------------------------
    '
        Dim sLettres    As String
        Dim lCompteur   As Long
        Dim lLongueur   As Long
        Dim lBoucle     As Long
        Dim lLenValues  As Long
        Dim lPosition   As Long
        'Définition de la longueur de la chaîne à crypter et de la chaîne de résultat
        lLongueur = Len(pChaine)
        sLettres = String(lLongueur, Chr(0))
        lLenValues = Len(gValues)
        'Boucler en fonction du nombre de rotations attendues
        For lBoucle = 1 To NBROTATIONSMAX
            'boucler pour chaque caractère de la chaîne initiale
            For lCompteur = 1 To lLongueur
                If InStr(gValues, Mid(pChaine, lCompteur, 1)) <> 0 Then
                    lPosition = ((InStr(gValues, Mid(pChaine, lCompteur, 1)) + lLenValues - 1) - ((InStr(gValues, Mid(CLEF, (lCompteur Mod Len(CLEF) + 1), 1)) * lLongueur) Mod lLenValues + 1)) Mod lLenValues + 1
                    Mid(sLettres, lCompteur, 1) = Mid(gValues, (lPosition))
                Else
                    Mid(sLettres, lCompteur, 1) = Mid(pChaine, lCompteur, 1)
                End If
            'recommencer
            Next
            'réaffecter la chaîne à crypter par le résultat trouvé pour pouvoir recommencer une itération
            pChaine = sLettres
        'Nouvelle itération
        Next
        'Renvoyer le résultat final
        Decrypter = sLettres
    End Function
    Essayer. Rater. Essayer encore. Rater encore. Rater mieux. (Samuel Beckett)
    Ou encore:
    Quand ça ne tourne pas rond dans le carré de l'hypothénuse , c'est signe qu'il est grand temps de prendre les virages en ligne droite.(Pierre Dac)
    ... Des principes qui m'ont beaucoup aidé en informatique...

  4. #4
    Membre expert

    Homme Profil pro
    consultant développeur
    Inscrit en
    mai 2005
    Messages
    2 273
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Val de Marne (Île de France)

    Informations professionnelles :
    Activité : consultant développeur
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : mai 2005
    Messages : 2 273
    Points : 3 614
    Points
    3 614
    Par défaut
    Excellent et merci de partager Risc500
    et une fois de plus chapeau bas devant maitre Arkham

    J'en ai pas besoin spécialement mais ca fait du bien.
    Cordialement
    "Always look at the bright side of life." Monty Python.

  5. #5
    Nouveau membre du Club
    Homme Profil pro
    Conseil - Consultant en systèmes d'information
    Inscrit en
    juillet 2017
    Messages
    31
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Conseil - Consultant en systèmes d'information

    Informations forums :
    Inscription : juillet 2017
    Messages : 31
    Points : 28
    Points
    28
    Par défaut
    Merci beaucoup, je vais tester!

    Citation Envoyé par Ric500 Voir le message
    Bonjour,

    Quant à moi j'utilise avec bonheur ce code provenant d'Arkham46: il permet d'octroyer une clé de licence à un prospect qu'il saisit dans une table paramètres, par exemple. La génération de clés se fait via un module qui procure une clé cryptée (ou pas) qui donne une durée de vie à l'utilisation de l'application, qui du coup peut être pleinement fonctionnelle. Tu peux générer des clés temporaires ou définitives selon ton besoin (après essai, tu fournis une clé définitive).

    Ci-après le module de Thierry, enjoy

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    Option Compare Database
     
    Option Explicit
    Option Private Module
    '----------------------------------------------------
    ' Exemple de génération de clé HEXA (0 à 9 et A à F)
    '----------------------------------------------------
    ' Pour personnaliser votre clé, modifier la valeur de gModulo
    '     et des multiplicateur dans la fonction GetMult
    ' Conservez la fonction GenerateKey hors de l'application
    '
    '----------------------------------------------------
     
    ' Modulo : Le Checksum doit être multiple de ce nombre
    ' Ce nombre doit être inférieur à la somme des multiplicateur * 15
    Private Const gModulo = 480
     
    ' Clé de cryptage
    Private Const CLEF As String = "A45RGT5FER6745GHTOGFSDOPK56453235K"
     
    ' Nombre d'itérations de la fonction maximum
    Private Const NBROTATIONSMAX       As Long = 13
     
    ' Valeurs possibles
    Private Const gValues = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
     
    Function DaysLeftK(sKey)
        DaysLeftK = CLng("&H" & Mid(sKey, 3, Mid(sKey, 2, 1))) - CLng(DateValue(Now))
    End Function
     
     
    ' Multiplicateurs pour calcul du checksum
    Private Function GetMult(pNum As Integer) As Integer
        Select Case pNum
            Case 1: GetMult = 10
            Case 2: GetMult = 13
            Case 3: GetMult = 9
            Case 4: GetMult = 11
            Case 5: GetMult = 14
            Case 6: GetMult = 12
            Case 7: GetMult = 3
            Case 8: GetMult = 2
            Case 9: GetMult = 7
            Case 10: GetMult = 6
            Case 11: GetMult = 5
            Case 12: GetMult = 4
            Case 13: GetMult = 8
            Case 14: GetMult = 15
            Case 15: GetMult = 1 ' Doit être égale à 1
        End Select
    End Function
     
    ' Vérifie si la clé est correcte
    ' Si la clé a été générée avec une date, vérifie si pValidDate est inférieur ou égale à cette date
    Public Function CheckKey(ByVal sKey As String, Optional pValidDate As Date) As Boolean
        On Error GoTo gestion_erreurs
        Dim lDate As Date
        ' Clé vide invalide
        If Len(sKey) = 0 Then
            CheckKey = False
            Exit Function
        End If
        ' Calcul du checksum
        If (GetCheckSum(sKey) Mod gModulo) = 0 Then
            ' Vérifie si la date est valide
            ' La date commence au troisième caractère si le premier caractère est D,
            '    sa longueur est écrite dans le deuxième caractère
            If Mid(sKey, 1, 1) = "D" Then ' On a codé une date dans la clé
               If pValidDate = Format("00:00:00") Then pValidDate = Now ' Vérifie à la date du jour par défaut
               If CLng("&H" & Mid(sKey, 3, Mid(sKey, 2, 1))) >= CLng(DateValue(pValidDate)) Then
                    CheckKey = True
               End If
            Else
                CheckKey = True
            End If
        End If
    Exit Function
    gestion_erreurs:
    CheckKey = False
    End Function
     
    ' Calcul le checksum
    Private Function GetCheckSum(sKey As String) As Long
        On Error GoTo gestion_erreurs
        Dim lChecksum As Long
        Dim lCpt As Integer
        lChecksum = 0
        For lCpt = 1 To Len(sKey)
            lChecksum = lChecksum + (GetMult(lCpt) * CLng("&h" & Mid(sKey, lCpt, 1)))
        Next
        GetCheckSum = lChecksum
        Exit Function
    gestion_erreurs:
        GetCheckSum = -1
    End Function
     
    ' Génère une clé
    ' Si pDate est précisée, la clé inclue cette date
    Public Function GenerateKey(Optional pDate As Date) As String
    Dim LKey As String
    Dim lLastNumber As Integer
    Dim lCpt As Integer
    Dim lModulus As Long
    Dim lNextNumber As Long
    Dim lCptFirst As Integer
     
    Do
        ' Initialise la clé
        LKey = ""
        If pDate = Format("00:00:00") Then
            ' Date non précisée
            ' Premier caractère = A
            LKey = "A"
            ' On commence la génération au deuxième caractère
            lCptFirst = 2
        Else
            ' Date précisée
            ' Premier caractère = D
            LKey = "D"
            ' On ajoute la taille de la date puis la date en Hexa
            LKey = LKey & CStr(Len(CStr(Hex(DateValue(pDate))))) & CStr(Hex(DateValue(pDate)))
            ' On poursuit la génération au caractère suivant la date
            lCptFirst = Len(LKey) + 1
        End If
        ' Jusqu'au caractère 12, génère des chiffres hexa aléatoires
        For lCpt = lCptFirst To 12
            LKey = LKey & CStr(Hex(15 * Rnd))
        Next
        ' Les trois derniers caractères sont calculés pour essayer d'atteindre
        '  un checksum correct (multiple de gModulo)
        For lCpt = 13 To 15
            lModulus = gModulo - (GetCheckSum(LKey) Mod gModulo)
            lNextNumber = lModulus \ GetMult(lCpt)
            If lNextNumber > 15 Then ' pas de chiffre supérieur à 15 (F en hexa)
                lNextNumber = 15
            End If
            LKey = LKey & CStr(Hex(lNextNumber))
        Next
    Loop Until (GetCheckSum(LKey) Mod gModulo) = 0  'On boucle tant qu'on a pas trouvé une clé valide
     
    GenerateKey = LKey
    End Function
     
    Public Function Crypter(ByVal pChaine As String)
    '---------------------------------------------------------------------------------------
    ' Procedure : Crypter
    ' Créée le  : lundi 18 juil 2005 18:51
    ' Auteur    : Maxence HUBICHE
    ' Site      : http://mhubiche.developpez.com
    ' Objet     : Crypter la chaîne en fonction d'une clef et de la méthode
    '               de Vigenère
    ' Adapaté par :
    ' Thierry GASPERMENT (Arkham46) Cryptage avec valeurs possibles
    '---------------------------------------------------------------------------------------
    ' Le chaine pChaine doit être composée de caractères présents dans gValues
    '---------------------------------------------------------------------------------------
     
        Dim sLettres    As String
        Dim lCompteur   As Long
        Dim lLongueur   As Long
        Dim lBoucle     As Long
        Dim lLenValues  As Long
        'Définition de la longueur de la chaîne à crypter et de la chaîne de résultat
        lLongueur = Len(pChaine)
        sLettres = String(lLongueur, Chr(0))
        lLenValues = Len(gValues)
        'Boucler en fonction du nombre de rotations attendues
        For lBoucle = 1 To NBROTATIONSMAX
            'boucler pour chaque caractère de la chaîne initiale
            For lCompteur = 1 To lLongueur
                If InStr(gValues, Mid(pChaine, lCompteur, 1)) <> 0 Then
                    Mid(sLettres, lCompteur, 1) = Mid(gValues, (InStr(gValues, Mid(pChaine, lCompteur, 1)) + _
                        (InStr(gValues, Mid(CLEF, (lCompteur Mod Len(CLEF)) + 1, 1)) * lLongueur)) Mod lLenValues + 1)
                Else
                    Mid(sLettres, lCompteur, 1) = Mid(pChaine, lCompteur, 1)
                End If
            'recommencer
            Next
            'réaffecter la chaîne à crypter par le résultat trouvé pour pouvoir recommencer une itération
            pChaine = sLettres
        'Nouvelle itération
        Next
        'Renvoyer le résultat final
        Crypter = sLettres
    End Function
     
    Public Function Decrypter(ByVal pChaine As String)
    '---------------------------------------------------------------------------------------
    ' Procedure : Decrypter
    ' Créée le  : 25 juin 2005 18:51
    ' Auteur    : Thierry GASPERMENT
    ' Site      : http://arkham46.developpez.com
    ' Objet     : Decrypter la chaîne en fonction d'une clef et de la méthode
    '               de Vigenère
    '---------------------------------------------------------------------------------------
    '
        Dim sLettres    As String
        Dim lCompteur   As Long
        Dim lLongueur   As Long
        Dim lBoucle     As Long
        Dim lLenValues  As Long
        Dim lPosition   As Long
        'Définition de la longueur de la chaîne à crypter et de la chaîne de résultat
        lLongueur = Len(pChaine)
        sLettres = String(lLongueur, Chr(0))
        lLenValues = Len(gValues)
        'Boucler en fonction du nombre de rotations attendues
        For lBoucle = 1 To NBROTATIONSMAX
            'boucler pour chaque caractère de la chaîne initiale
            For lCompteur = 1 To lLongueur
                If InStr(gValues, Mid(pChaine, lCompteur, 1)) <> 0 Then
                    lPosition = ((InStr(gValues, Mid(pChaine, lCompteur, 1)) + lLenValues - 1) - ((InStr(gValues, Mid(CLEF, (lCompteur Mod Len(CLEF) + 1), 1)) * lLongueur) Mod lLenValues + 1)) Mod lLenValues + 1
                    Mid(sLettres, lCompteur, 1) = Mid(gValues, (lPosition))
                Else
                    Mid(sLettres, lCompteur, 1) = Mid(pChaine, lCompteur, 1)
                End If
            'recommencer
            Next
            'réaffecter la chaîne à crypter par le résultat trouvé pour pouvoir recommencer une itération
            pChaine = sLettres
        'Nouvelle itération
        Next
        'Renvoyer le résultat final
        Decrypter = sLettres
    End Function

Discussions similaires

  1. date d'expiration pour une application ACCESS
    Par Abdel Illah dans le forum VBA Access
    Réponses: 3
    Dernier message: 26/11/2011, 03h07
  2. Réponses: 3
    Dernier message: 31/07/2008, 16h21
  3. Quels composants utiliser pour une application client/serveur (mySql) ?
    Par whitespirit dans le forum Bases de données
    Réponses: 20
    Dernier message: 30/01/2008, 06h46
  4. [VB6] Comment faire pour limiter l'utilisation d'une application
    Par Lucas42 dans le forum VB 6 et antérieur
    Réponses: 3
    Dernier message: 15/06/2006, 09h43
  5. Réponses: 2
    Dernier message: 08/06/2006, 15h38

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo