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 468 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.
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.
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
- Module de cryptage par la methode de porta pour tout type de fichier
- Cryptage de chaine: méthode de vigenère - Codes sources - Visual Basic / VB.NET (Sécurité)
- C# / .NET : Cryptage par la méthode de vigenere - CodeS SourceS - Guide
- Petit module de cryptage - Codes sources - Visual Basic / VB.NET (Divers)
- Visual Basic / VB.NET : Module de cryptage vigenère - CodeS SourceS - Guide
- Java : Cryptage selon la méthode de césar - CodeS SourceS - Guide
Du même auteur (gandalfkhorne)
-
Fonction de decoupe de chaine, grace a instr
-
Module de decoupage elliptique de controls : text, form, command, scrolls, slider, ...
-
Base de gestionnaire de fichier, a finir tres simplement
-
Effet pour form, changement de fond, d'icone et titre deroulant (en fonction du temps)
-
Effet sur des picturebox : code tres simple, fluide et commenter
- Messages postés
-
4172
- Date d'inscription
- mercredi 30 juillet 2003
- Statut
- Membre
- Dernière intervention
- 9 juin 2006
25- Messages postés
-
4172
- Date d'inscription
- mercredi 30 juillet 2003
- Statut
- Membre
- Dernière intervention
- 9 juin 2006
25Mais 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
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
Mais je trouve ta source bien quand même donc je conserve le 9...
Saros
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.