Encryptage/decryptage

Soyez le premier à donner votre avis sur cette source.

Snippet vu 16 266 fois - Téléchargée 88 fois

Contenu du snippet

Le code se compose de deux fonctions publiques vous permettant d'encrypter et de décrypter un message. L'aspect intérressant réside dans le fait que vous pouvez crypter un message soit un nombre de fois, soit jusqu'à ce qu'il atteigne une certaine taille.

La méthode de cryptage est basée sur la conversion des caractères du code ASCII (8-bits) vers un autre dictionnaire (6-bits). Si vous avez des questions sur le code, n'hésitez pas à me contacter.

Sauvez le code dans un module et amusez-vous.

Source / Exemple :


Option Explicit
' ****************************************************************************
' *** Fonctions de cryptage/décryptage ******************************* 1.1 ***
' ****************************************************************************
' * N'hésitez pas à m'envoyer un mail si:                                    *
' * - Vous souhaitez me donnez vos impressions                               *
' * - Vous avez envie de me faire partager des modifications de code que vous*
' *   auriez faites.                                                         *
' ****************************************************************************
' * AUTEUR: FlyKiller.                                                       *
' ****************************************************************************
Private Const CodeChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-/"
Public Enum CryptMethods
  cmNumberOfTime
  cmRaiseLenght
End Enum
Private Enum BitCoding
  bc6Bits = 5
  bc8Bits = 7
End Enum

' ****************************************************************************
' *** FUNCTION CryptMsg ******************************************************
' *--------------------------------------------------------------------------*
' * PARAMETRES:                                                              *
' * - Msg: message à crypter.                                                *
' * - CryptMethod: spécifie si il faut crypter x fois (NumberOfTime) ou      *
' *                jusqu'à ce que le message crypté arrive à une taille      *
' *                limite (RaiseLength)                                      *
' * - CryptLimit: nombre de fois qu'il faut crypter (si NumberOfTime) ou     *
' *               taille maximale que le message crypté ne peut dépasser     *
' *               (si RaiseLength)                                           *
' *--------------------------------------------------------------------------*
' * VALEURS RETOURNEES:                                                      *
' * - Retour de la fonction: Message crypté.                                 *
' * - CryptLimit: Nombre de fois que le message a été réellement crypté.     *
' *               (Utile pour décrypter le message s'il a été encrypté       *
' *                plusieurs fois de suite)                                  *
' ****************************************************************************
Public Function CryptMsg(ByVal Msg As String, _
                         Optional ByVal CryptMethod As CryptMethods = cmNumberOfTime, _
                         Optional ByRef CryptLimit As Integer = 1) As String
Dim BS As String
Dim I As Integer

  If CryptMethod = cmNumberOfTime Then
    For I = 1 To CryptLimit
      BS = GetBitString(Msg, bc8Bits)
      Msg = GetConvertedString(BS, bc6Bits)
    Next
    CryptMsg = Msg
  Else
    I = 0
    While Len(Msg) < CryptLimit
      BS = GetBitString(Msg, bc8Bits)
      Msg = GetConvertedString(BS, bc6Bits)
      If Len(Msg) <= CryptLimit Then CryptMsg = Msg: I = I + 1
    Wend
    CryptLimit = I
  End If
End Function

' ****************************************************************************
' *** FUNCTION UncryptMsg ****************************************************
' ****************************************************************************
Public Function UncryptMsg(ByVal Msg As String, _
                Optional ByVal UncryptRepeat As Integer = 1) As String
Dim BS As String

  UncryptMsg = Msg
  While UncryptRepeat > 0
    BS = GetBitString(UncryptMsg, bc6Bits)
    BS = Mid$(BS, 1, (Len(BS) \ 8) * 8)
    UncryptMsg = GetConvertedString(BS, bc8Bits)
    UncryptRepeat = UncryptRepeat - 1
  Wend
End Function

' ****************************************************************************
' *** FUNCTION GetBitString **************************************************
' ****************************************************************************
Private Function GetBitString(ByVal Msg As String, _
                              ByVal BitPerChar As BitCoding) As String
Dim LetterIdx As Integer
Dim AscLetter As Integer
Dim BitIdx As Integer

  For LetterIdx = 1 To Len(Msg)
    If BitPerChar = bc8Bits Then
      AscLetter = Asc(Mid$(Msg, LetterIdx, 1))
    Else
      AscLetter = InStr(CodeChars, Mid$(Msg, LetterIdx, 1)) - 1
    End If
    For BitIdx = BitPerChar To 0 Step -1
      If AscLetter And 2 ^ BitIdx Then
        GetBitString = GetBitString & "1"
      Else
        GetBitString = GetBitString & "0"
      End If
    Next
  Next
End Function

' ****************************************************************************
' *** FUNCTION GetConvertedString ********************************************
' ****************************************************************************
Private Function GetConvertedString(ByVal BitString As String, _
                                    ByVal BitPerChar As BitCoding) As String
Dim LetterIdx As Integer
Dim AscLetter As Integer
Dim BitIdx As Integer

  For LetterIdx = 1 To Len(BitString) Step BitPerChar + 1
    AscLetter = 0
    For BitIdx = 0 To BitPerChar
      If Mid$(BitString, LetterIdx + BitIdx, 1) = "1" Then
        AscLetter = AscLetter Or (2 ^ (BitPerChar - BitIdx))
      End If
    Next
    If BitPerChar = bc8Bits Then
      GetConvertedString = GetConvertedString & Chr$(AscLetter)
    Else
      GetConvertedString = GetConvertedString & Mid$(CodeChars, AscLetter + 1, 1)
    End If
  Next
End Function

Conclusion :


(06-02-2000) Version 1.1: La fonction de décryptage ne fonctionnait pas quand on décryptait plusieurs fois de suite: c'est corrigé. Merci E. Coquinot.

A voir également

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
mardi 9 septembre 2003
Statut
Membre
Dernière intervention
10 novembre 2003

C'est vrai, aucun code n'est inviolable c'est une question de temps et de patience à l'exception le codage quantique et encore ?
Dans tous les cas il faut respecter la production des autres.
Messages postés
37
Date d'inscription
mardi 8 juillet 2003
Statut
Membre
Dernière intervention
27 avril 2006

mon cher tmcuh, je ne sais pas d'où tu tire que le RSA 1024 bits a été cassé, mais certainement de tes rêves, la plus longue clé cassée aujourd'hui est de 532 bits. J'ai travaillé sur le RSA 1024 bits pendant 6 mois et je peux t'assurrer que tu fais fausse route!!(t gentil quand même)
Messages postés
4
Date d'inscription
mercredi 18 décembre 2002
Statut
Membre
Dernière intervention
30 septembre 2004

Hi ryadh27

sors ta facture il est dessus

bref de lol
Autremetn une piste :
il faut faire un reset du cmos bonne chance sur le démontage du portable
Messages postés
1
Date d'inscription
mercredi 14 mai 2003
Statut
Membre
Dernière intervention
14 mai 2003

J4AI UN PROBLEME J'ai acheter un pc portable et d'est que je demare il me demande un mot de passe pour continuer ?j'arrive meme pas a demarer sur msdos meme avec une disquette de boot????peut tu maider stp et me dire si il existe un programe pour decripter le mot de passe merci..pour ton aide ...
Messages postés
458
Date d'inscription
dimanche 22 décembre 2002
Statut
Membre
Dernière intervention
18 avril 2009

Je confirme ce que dit Pirate, vous avez l'air de dire que c'est un gros nul n'empèche qu'il a raison. Chaque lettre ou chiffre est codé suivant le même critère il devient vite possible de crée une table et ainsi trouvé l'algorithme, un peu comme j'avais fais pourl le code d'écran de veille de windob!!
Afficher les 12 commentaires

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.