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...
Source / Exemple :
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
Conclusion :
Ce n'est qu'un exemple parmi tant d'autres, et peut-être une base pour faire beaucoup mieux !
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.