CRYPTAGE SIMPLE EN XOR AVEC CLÉ ALÉATOIRE.

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