CRYPTAGE SIMPLE EN XOR AVEC CLÉ ALÉATOIRE.

---

Commentaire sur cette source (0)
Ajouter un commentaire et/ou une note

Ce module permet de crypter de façon simple une chaine ou un fichier de paramétrage d'application par exemple. Il est clair que le cryptage XOR ne convient pas pour des données TRèS sensibles, il décourage les simples curieux. Au lancement de l'application on decode_ini() et à l'arrêt on code_ini().
Il faut definir les points suivants :
gIniSrc = Extension du fichier initial non crypté ( ".src")
gIniExt = Extension du fichier crypté (".dat")
Et voilà pour un exemple de traitement...

Option Explicit
'***************************************************************************
'Module : modCrypt.bas
'Version : 1.0.0
'Auteur : DChomet
'Description : Ce module permet de crypter une chaine ou un fichier en XOR
'***************************************************************************
'CODAGE
'm_Cle = CreateCle()
'Message = m_Cle & Crypt(Message, m_Cle)

'DECODAGE
'm_Cle = Left$(Message, 2)
'tmpMsg = Crypt(Mid$(Message, 3), Val(m_Cle))

Private Function CreateCle() As String
    'renvoi une clé aléatoire entre 10 et 99
    CreateCle = Int((Rnd * 90) + 10)
End Function

Function Code(ByVal m_msg As String) As String
    '?Code("Ceci est ma chaine")
    If m_msg = "" Then Exit Function
    If (VBA.Left$(m_msg, 2) = "__") Then
        Code = m_msg
    Else
        Dim m_Cle As String
        m_Cle = CreateCle()
        Code = "__" & m_Cle & Crypt(m_msg, m_Cle)
    End If
End Function

Function Decode(ByVal m_msg As String) As String
    '?Decode("__67."*/7,y m',.*")
    If m_msg = "" Then Exit Function
    If (VBA.Left$(m_msg, 2) <> "__") Then
        Decode = m_msg
    Else
        Dim m_Cle As String
        m_Cle = VBA.Mid$(m_msg, 3, 2)
        Decode = Crypt(VBA.Mid$(m_msg, 5, Len(m_msg)), VBA.Val(m_Cle))
    End If
End Function

Sub code_ini()
    Dim iniCode As Integer, F As Integer, p As String, m As Long
    If Dir(App.Title & "_config" & gIniSrc) <> "" Then
        'If gIniIdx = 0 Then
        gIniIdx = FreeFile
        Open App.Title & "_config" & gIniSrc For Binary As #gIniIdx
        'End If
        If Dir(App.Title & "_config" & gIniExt) <> "" Then Kill App.Title & "_config" & gIniExt
        iniCode = FreeFile
        Open App.Title & "_config" & gIniExt For Binary As #iniCode
        m = LOF(gIniIdx)
        p = String(m, Chr(0))
        Get #gIniIdx, 1, p
        Put #iniCode, , Code(p)
        Close #gIniIdx: gIniIdx = 0
        Close #iniCode
        If Dir(App.Title & "_config" & gIniSrc & "_BAK") <> "" Then Kill App.Title & "_config" & gIniSrc & "_BAK"
        Name App.Title & "_config" & gIniSrc As App.Title & "_config" & gIniSrc & "_BAK"
        If Dir(App.Title & "_config" & gIniSrc) <> "" Then Kill App.Title & "_config" & gIniSrc
    End If
End Sub

Sub decode_ini()
    Dim iniCode As Integer, p As String, m As Long
    If Dir(App.Title & "_config" & gIniExt) <> "" Then
        iniCode = FreeFile
        Open App.Title & "_config" & gIniExt For Binary As #iniCode
        If Dir(App.Title & "_config" & gIniSrc) <> "" Then Kill App.Title & "_config" & gIniSrc
        'If gIniIdx = 0 Then
        gIniIdx = FreeFile
        Open App.Title & "_config" & gIniSrc For Binary As #gIniIdx
        'End If
        m = LOF(iniCode)
        p = String(m, Chr(0))
        Get #iniCode, 1, p
        Put #gIniIdx, , Decode(p)
        Close #iniCode
        'On ne ferme surtout pas le fichier, cela sert de verouillage pendant le fonctionnement
        Close #gIniIdx: gIniIdx = 0
        '========
    End If
End Sub

Function Crypt(ByVal Text As String, ByVal Cle As Integer)
    Dim i As Long, S As String
    For i = 1 To Len(Text)
        S = S & Chr$(Cle Xor Asc(Mid$(Text, i, 1)))
    Next
    Crypt = S
End Function

Ce n'est qu'un exemple parmi tant d'autres, et peut-être une base pour faire beaucoup mieux !

• LES ACL (ACCESS CONTROL LIST ) STANDARD EN VB
• SIMULATION D'UNE CONNEXION NETBUS
• TRACE ERASE
• VBSPAMCHECK : RÉCUPÉRER LES COURRIELS LÉGITIMES DANS UNE BASE DE SPAM DBX
• PROTECTION PAR MOT DE PASSE