Module de cryptage par la methode de porta pour tout type de fichier

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 414 fois - Téléchargée 29 fois

Contenu du snippet

Voili, voilà, étant donné le peu de résultat quand on se fait chier pour des newbies pendant 3 heures à faire une source nickel que j'ai posé hier sans avoir aucune réponse alors que ce projet aborde vraiment plein de points de la programmation, j'ai donc décider de poster une petite fonctions qui elle risque d'interesser un pti bout de monde ;)

Comme je l'ai bien expliciter, ce code permet juste de crypter n'importe quel fichier par la méthode de Porta, il suffit de crypter le fichier avec un clé et de le recrypter avec celle-ci pour qu'il se décrypte penser au MMe qui veut dire "Même"soit un algorithme symétrique, sur mon Pc il fait du 80Ko.s-1 en moyenne.

Source / Exemple :


Option Explicit ''Sert à définir l'espace de la pile en fonction des variables

Public Function ChiffrePortaMme(ByVal AdFile As String, ByVal Clé As String) As Boolean
    ''Déclarations des variables''
    Dim ff1 As Integer, ff2 As Integer, Cpt As Double, MatPorta As Variant
    Dim v1 As Integer, v2 As Integer, Dec As Integer, NVar As Integer, NbMat As Integer
    Dim BitRec As Byte, BitCry As Byte, RdClé As Byte, NbDT As Long
    
    On Error GoTo F ''S'il y a une erreur il s'en va de la fonction (Exit Function)
    ReDim MatPorta(509, 255) As Byte 'Redimension sans preservation des données de la matrice Porta
    ''Pour comprendre cette partie là quoi de mieux que de voir ceci :
    ''http://www.jura.ch/lcp/cours/dm/codage/porta/index.html
    ''Pour info j'ai fait le meme type mais avec des chiffres (2 bits = soit x de 0 à 255)
    ''première ligne : 01 ||  0   1  ..... 126 127
    ''                    || 128 129 ..... 254 255
    ''deuxieme ligne : 23 ||  0   1  .........
    ''                    || 255 128 .........
    For v1 = 0 To 254 Step 2
        Let NVar = 127 + Dec
        For v2 = 0 To 127
            If NVar > 255 Then Let NVar = 127
            Let MatPorta(2 * v1 + 1, v2) = NVar
            Let MatPorta(2 * v1 + 1, NVar) = v2
            Let NVar = NVar + 1
        Next v2
        Let Dec = Dec + 1
    Next v1
    '''''Fin du truc bien compliqué'''''
    Let AdSbb = AdFile & "khozaz" 'Nouvelle adresse "temporaire"
    FileCopy AdFile, AdSbb 'Copie du fichier d'origine en fichier "temporaire" pour préserver les données en cas de foirage
    Let ff1 = FreeFile() 'donne un numéro d'accés libre pour ouvrir le fichier d'origine
    Open AdFile For Binary Access Read As #ff1 'Ouvre en mode binaire en lecture le fichier d'origine
        Lock #ff1 'Bloque l'acces du fichier d'origine
        Let ff2 = FreeFile() ''''
        Open AdSbb For Binary Access Write As #ff2 '''Mode binaire pour ecriture
            Lock #ff2 'bloque laccès
            For Cpt = 1 To LOF(ff1) 'Pour Cpt variant du 1er bit au dernier du fichier d'origine
                Let CurClé = CurClé + 1 ''''''''''''''''Index rotatif
                If CurClé > Len(Clé) Then Let CurClé = 1 '<-retour sur lindex minimum une fois le maximum + 1 atteint
                Let RdClé = Asc(Mid(Clé, CurClé, 1)) 'découpe un morceau de clé et le code en ascii
                Get #ff1, Cpt, BitRec 'Implémentation de la valeur du Cpt ième bit du fichier d'origine dans BitRec
                If Int(RdClé / 2) = RdClé / 2 Then Let NbMat = 2 * RdClé + 1 Else: Let NbMat = 2 * RdClé - 1 'Séléction "Portienne" de la section matricielle
                Let BitCry = MatPorta(NbMat, BitRec) 'Résultat du codage implémenter sous BitCry
                Put #ff2, Cpt, BitCry 'BitCry est écrit au Cpt ième bit du fichier
            Next 'Boucle sur le for
           Unlock #ff2 'Debloque l'accès au fichier "temporaire"
        Close #ff2 'Ferme le fichier "temporaire"
        Unlock #ff1 'Debloque l'accèes au fichier d'origine
    Close #ff1 'Ferme le fichier d'origine
    FileCopy AdSbb, AdFile 'Copie du fichier "temporaire" sous le fichier d'origine
    SetAttr AdSbb, vbNormal ''
    Kill (AdSbb) '''''''''''''Supprime le fichier "temporaire"
    Let ChiffrePortaMme = True 'Renvoi la valeur Vrai soit l'opération à réussie
F:

End Function

'---------------------------------------------------------------------------------------------'

''Autre module''

''Déclarations des Api''
Public Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Public Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long
Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long

''Déclaration du type pointapi''
Public Type POINTAPI
        x As Long
        y As Long
End Type

''Déclarations du type MSg
Public Type Msg
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

''Déclarations des constantes
Public Const PM_REMOVE = &H1
Public Const PM_NOYIELD = &H2
Public Const PM_NOREMOVE = &H0

Dim msg_ As Msg

''Module remplaçant le Doevents (attention au debogage un bon pti foirage lol)

Public Sub DoEvnts()

    Do While PeekMessage(msg_, 0, 0, 0, PM_REMOVE)
        TranslateMessage msg_
        DispatchMessage msg_
    Loop

End Sub

Conclusion :


J'éspère que cette fonction pourra vous servir à vous apprendre le traitement de données en binaire bien qu'il y ait certaine faille.

A voir également

Ajouter un commentaire

Commentaires

Messages postés
38
Date d'inscription
mardi 17 décembre 2002
Statut
Membre
Dernière intervention
25 janvier 2006

Même si je doute d'en avoir l'utilité, je trouve ce code vraiment sympathique, merci bien :]
Messages postés
4172
Date d'inscription
mercredi 30 juillet 2003
Statut
Membre
Dernière intervention
9 juin 2006
21
PS : Tu peux enlevé les "Let" dans tes affectations, il est optionnel en VB. Et a part allourdir le code, je le trouve pas super utile
Messages postés
4172
Date d'inscription
mercredi 30 juillet 2003
Statut
Membre
Dernière intervention
9 juin 2006
21
Ce que veux dire arny a propos de ta gestion d'erreur, je crosi que c'est que tu colles 1 "Goto" et si Warny est un membre de l'amicale des anti Code-Spaghetti (dont je suis, enfin parfois), et ben c'est pas cool de mettre des goto, meme pour une gestion d'erreur.
Mais bon, bien qu'étant un anti-goto, je mets régulièrement des On Error goto ... dans mes codes. Mais ce sont les seuls, je jure, m'sieur !!
sinon j'aime bcp ta source : 8/10
Messages postés
70
Date d'inscription
dimanche 11 janvier 2004
Statut
Membre
Dernière intervention
1 octobre 2004

Pour PaTaTe je voulais juste dire que comme je lai expliker le cryptage et le decryptage sont effectué simpleme,t par rapport à la parité du nombre de fois que lon crypte le msg.

Sinon pour le On error je vois ce que tu veux dire, mais c une solution comme les autres si tu veux bien mexpliker en koi c mieux pour ca cas-ci, vu que les ereurs je lai renvoi a la fin.

et le DoEvnts je l'ai pris sur le site, donc la source y est deja
Messages postés
921
Date d'inscription
vendredi 20 décembre 2002
Statut
Membre
Dernière intervention
23 septembre 2010

Oups je me suis trompé de source en postant le commentaire :)
Mais je trouve ta source bien quand même donc je conserve le 9...
Saros
Afficher les 11 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.