Macro VBA non résolue malgrés 10 jours passé dessus

Bonjour à tous,

Je n'utilise VBA que très rarement et là je butte sur un problème de boucles imbriquées.

Je cherche à comparer des données issues de "scans" de badge Mifare de 1 Ko.

Je peux scanner ces badges de 2 façons :

1) Avec mon téléphone portable et l'application MCT (Mifare Clone Tool) qui permet de récupérer un fichier de 2292 Octets

2) Avec Kali Linux qui permet de récupérer un fichier de 1024 Octets. Soit une Image fidèle du contenu du badge.

N'étant pas programmeur, j'ai utilisé Excel avec lequel je lis le fichier de 2292 octets que je met dans un tableau ( rapidité de traitement et possibilité de taille très grande)

Je recherche les différences entre les deux fichiers qui sont :

1) des octets inutiles qui sont du texte "Sector: x ou xx) pour une comparaison future avec un fichier de 1024 octets

2) des retour lignes CrLf ou 0x0A ou 10 en décimal: j'ai crée un tableau TableauBytes0A()

3 ) chaque chaine décrivant le secteur concerné commence par un "+" ou 0x2B ou 43 en décimal : j'ai crée un tableau TableauBytes2B() qui ne me semble pas utile.

Je cherche donc à remplir un tableau TableauBytesSupp() qui me liste tous les octets à supprimer pour ensuite pouvoir écrire un fichier de 1024 octets et c'est là que je suis bloqué.

Merci à quiconque pourrait m'aider, le reste ne devrait pas me poser de soucis.

Bonjour,

regarde de plus près tes fichiers, c'est beaucoup plus simple :

Ce qui donne :

Option Explicit

Sub test()
    Dim s As String, d As String
    s = "D:\tmp1\UID_B2EC0A05_BeepBleuIntratone4Btn"
    d = "D:\tmp1\test.dmp"
    convert s, d
End Sub

Sub convert(fichSource As String, fichDest As String) 'chemin+fichier
    Dim strLine As String, strContent As String, tmp
    Dim numfich As Integer, i As Long, j As Long

    numfich = FreeFile
    Open fichSource For Input As #numfich
    Do While Not EOF(numfich)
        Line Input #numfich, strLine
        tmp = Split(strLine, vbLf)
        For i = 0 To UBound(tmp)
            If Left(tmp(i), 1) <> "+" Then
                For j = 1 To Len(tmp(i)) Step 2
                    strContent = strContent & Chr("&H" & Mid(tmp(i), j, 2))
                Next j
            End If
        Next i
    Loop
    Close #numfich
    numfich = FreeFile
    Open fichDest For Output As #numfich
    Print #numfich, strContent;
    Close #numfich
End Sub

Je n'ai pas contrôlé tous les octets mais les checksums SHA-1 de dest.dmp et BeepBleuIntratone4BtnVierge.dmp sont bien identiques.

eric

Bonjour Eric,

Merci pour cette réponse si rapide et compacte.

C'est pour moi un joli cadeau pour mes 68 ans que je vais atteindre à la fin de ce mois.

J'avais bien remarqué que les octets étaient scindés en 2. Je vais analysé votre mode opératoire et approfondir les fonctions R/W de fichier.

Concernant votre remarque à propos de la vérification totale avec calcul du SHA,

Vous auriez aussi pu utiliser WinHex via le menu : Outils

Outils de Fichier

Comparer

Saisir 1024 Dans la case Comparer

Possible de modifier Chemin et nom du rapport

Puis Ok

Résultat Pas de différence(s) sinon le rapport indique ligne par ligne pour les octets différents la position de chacun dans la première colonne et dans les 2 suivantes la valeur dans chacun des fichiers.

Mais comme je suis assez "jusqu'au boutiste", et si vous avez l'envie et le temps de trouver dans mon VBA le pourquoi ça bug à : IndiceSupp N° 15 Cellule P 35 ?

Question subsidiaire : Quel Soft utilisez vous pour commenter en rouge vos images ?

Encore merci.

Bien cordialement.

Francis

Bien cordialement

Bonjour,

Pour les hashcode je n'ai pas de soucis, j'ai un utilitaire ajoute un onglet dans les propriétés.

Je les ai toujours sous la main.

Mais comme je suis assez "jusqu'au boutiste", et si vous avez l'envie et le temps de trouver dans mon VBA le pourquoi ça bug à : IndiceSupp N° 15 Cellule P 35 ?

Je t'avoue que j'avais refermé ton fichier bien vite en voyant le tableau et le paquet de lignes de code...

Je n'ai pas trouvé l'erreur annoncée (mais j'ai dû changer pour mettre le fichier que tu as fourni).

Par contre il semble que tu aies une boucle sans fin dans :

Static Sub TabSupp()
        '...
       Do While Not intCptTabSupp = intCptTabBytesLus + 1 'De 0à 2292

aucun incrément sur l'une ou l'autre variable.

Je n'ai pas été plus loin.

Pour les captures écran j'utilise Snagit, je le trouve pas trop mal.

Mais c'est payant, tu devrais pouvoir trouver un équivalent gratuit.

Je t'ai ajouté des commentaires pour la compréhension du principe appliqué :

Sub convert(fichSource As String, fichDest As String) 'chemin+fichier
    Dim strLine As String, strContent As String, tmp
    Dim numfich As Integer, i As Long, j As Long

    numfich = FreeFile
    Open fichSource For Input As #numfich
    Do While Not EOF(numfich)
        Line Input #numfich, strLine 'en fait il n'y a qu'une seule ligne, donc je n'ai pas mis de boucle
        tmp = Split(strLine, vbLf) ' découpe la chaine sur 0A
        For i = 0 To UBound(tmp) 'pour chaque morceau
            If Left(tmp(i), 1) <> "+" Then ' si début <> "+"
                For j = 1 To Len(tmp(i)) Step 2
                    ' lire les 2 caractères de la valeur hexa, la convertir en 1 octet et l'ajouter à la chaine résultat
                    strContent = strContent & Chr("&H" & Mid(tmp(i), j, 2))
                Next j
            End If
        Next i
    Loop
    Close #numfich
    ' ecrire résultat dans fichier
    numfich = FreeFile
    Open fichDest For Output As #numfich
    Print #numfich, strContent;
    Close #numfich
End Sub

Si c'est le 29 ton anniv, tu dois être content cette année

eric

Bonsoir Eric,

Merci pour tes réponses et ta coopération.

Je vais mettre en résolu.

Heureusement c'est le 27, ainsi j'ai des cadeaux tous les ans et non tous les 4 ans !!!!

Bien Cordialement

Francis