Soyez le premier à donner votre avis sur cette source.
Snippet vu 4 468 fois - Téléchargée 29 fois
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
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
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.