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

Commenter

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

S'inscrire maintenant

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.

Du même auteur (gandalfkhorne)