Extraire une image.jpg d'une feuille.mhtRésolu

Question

--JP Ambulancier--
bonjour a tous.
j'ai enregistré une page web en mht...les Images sont codées dans la page.
de cette page j'extrait divers texte ca c'est ok.
mais je n'ai aucune idée de comment je peu exploité les data de limage codée pour les afficher dans un controle
SVP si vous avez une idée...
je suis surtout sur excel mais un code Vb6 sera le bien venu ou juste la marche a suivre.
MERCI a tous @+

mjpmjp · Accepted Answer

bonjour a tous
si on enregistre la page(ou est ce message) en .mht,
on trouve ce texte :
Content-Type: image/jpeg
Content-Transfer-Encoding: base64
Content-Location: Content-Location: http://www.vbfrance.com/gdi/um/80530.cs.jpg

/9j/4AAQSkZJRgABAgEASABIAAD/4QdxRXhpZgAATU0AKgAAAAgABwESAAMAAAABAAEAAAEaAAUA... 
...r/W+LJJT7FXYq/wD/2QA=  L'indicateur de début du code c'est la ligne : 
Content-Location:http://www.vbfrance.com/gdi/um/80530.cs.jpg

L'indicateur de derniere ligne du code c'est la ligne :
et surtout le signe " ="
r/W+LJJT7FXYq/wD/2QA= 

 liste des taches 
ouvrir le fichier
lire les lignes dans un tableau
parcourir le tableau a la recherche de L'indicateur de début
a partir de cette ligne, +2 ligne (une ligne separe l'indicateur du code b64)
mettre cette ligne dans une variable (ImageB64...)
si cette ligne est L'indicateur de derniere ligne 
on sort de la boucle et on decode la variableB64
ou on continue ligne +1

on decode la variableB64
on ouvre le fichier.jpg
on y ecrit la variableB64 decodé
on ferme le fichier

dans un controle image on charge la nouvelle image.jpg

Public Sub Extraction_Data_Fichier()
    Dim FichierName As String   'nom du fichier
    Dim ImageB64 As String     'variable contient codeB64
    ImageB64  = ""              'vide
    Set fs = CreateObject("Scripting.FileSystemObject")
    'dans le cas ou le titre de la page.mht
    'se trouve dans une Liste et est sélectionné
    'FichierName = DataTransfer.ListFile.Value
    FichierName = "C:\Users\JP\Documents\CodesSources\base 64\Extraire une image_jpg d'une feuille_mht - Multimédia - Image & Vidéo, Visual Basic, VB6, VB_NET, VB 2005, VB_aspx.mht"
    If Right(FichierName, 4) = ".mht" Then
        'met les lignes de la feuille.mht dans le tableau FichierLigne
        FichierLigne = LireFichier(FichierName)
        For i = 0 To UBound(FichierLigne)
        TabElementData = Split(FichierLigne(i), delimiter:="Content-Location: http://www.vbfrance.com/gdi/um/80530.cs.jpg")
            If UBound(TabElementData) > 0 Then
                'ouvre un fichier.txt et ecrit les ligne jusqu'a "="
                'si on veut creer un fichier.b64
                'Set a = fs.CreateTextFile("C:\Users\JP\Documents\CodesSources\base 64\ImageB64.b64", True)
                For j = i + 2 To UBound(FichierLigne)
                    'ecrit ligne code b64 dans fichier.b64
                    'a.WriteLine (FichierLigne(j))
                    'ecrit ligne code b64 dans variable
                    ImageB64 = ImageB64 & FichierLigne(j)
                    'test si derniere ligne
                    If Right(FichierLigne(j), 1) = "=" Then Exit For
                Next j
                'ferme le fichier
                'a.Close
                b = j
                Exit For
            End If
        Next i
        'decode ImageB64 dans ImageBin
        ImageBin = Base64Decode(ImageB64)
        DoEvents
        'creation du fichier Image.png
        Set a = fs.CreateTextFile("C:\Users\JP\Documents\CodesSources\base 64\Image.jpg", True)
        'ecrit dans Image.jpg
        a.WriteLine (ImageBin)
        a.Close
        DoEvents
        'charge dans le controle Image "ImgWeb" du Form "DataTransfer" l'image "Image.jpg"
        DataTransfert.ImgWeb.Picture = LoadPicture("C:\Users\JP\Documents\CodesSources\base 64\Image.jpg")
    End If
End Sub

Public Function LireFichier(FichierName As String)
    Dim TabLigneFichier() As String
    Dim LigneFichier As String
    Dim NombreDeLigne As Long
    NombreDeLigne = 0
    'Ferme le canal #1
    Close #1
    'Ouvre le Fichier
    Open FichierName For Input As #1
    'Effectue la boucle jusqu'à la fin du fichier
    Do While Not EOF(1)
    NombreDeLigne = NombreDeLigne + 1
    'redimentionne le tableau en gardant le contenu
    ReDim Preserve TabLigneFichier(NombreDeLigne)
    'Lit la ligne dans la variable
    Line Input #1, LigneFichier
    TabLigneFichier(NombreDeLigne) = LigneFichier
    Loop
    'Ferme le canal #1
    Close #1
    'le résultat de la Fonction est TabLigneFichier
    LireFichier = TabLigneFichier
End Function

'============================================================================================
'CodesSources\base 64\BASE64 DECODAGE , Source N°32221 Visual Basic, VB6, VB_NET, VB 2005, VB
'Auteur : amine_hassini
'============================================================================================

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Public Function Base64Decode(base64String As String)
    Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Dim dataLength As Double
    Dim sOut As String
    Dim groupBegin As Double
    Dim numDataBytes, nGroup
    Dim thischar As String * 1
    Dim pOut As String
    Dim CharCounter As Byte
    Dim thisData As Byte
    Dim qq As Double
    'Dim cond As Boolean
    Dim amine() As String * 4

    base64String = Replace(base64String, vbCrLf, "")
    base64String = Replace(base64String, vbTab, "")
    base64String = Replace(base64String, " ", "")
    'la longueur de la chaîne passée doit être un multiple de 4
    dataLength = Len(base64String)
    If dataLength Mod 4 <> 0 Then
        Err.Raise 1, "Base64Decode", "Bad Base64 string."
        Exit Function
    End If
    ReDim amine(dataLength / 4)
    For i = 0 To (dataLength / 4) - 1
        amine(i) = Mid(base64String, (i * 4) + 1, 4)
    Next i
    'Decodage de chaque groupe:
    kk = UBound(amine)
    For groupBegin = 0 To kk - 1
        'Chaque groupe se transforme en 3 octets.
        numDataBytes = 3
        nGroup = 0
        For CharCounter = 0 To 3
            'On convertit chaque caractère en 6 bits de données, et l'ajouter à un
            'entier pour assurer le stockage temporaire. Si le caractère est
            'un '=', il y a un byte de données de moins (il ne peut avoir que 2 '=' au
            'maximum dans toute la chaine).
            thischar = Mid(amine(groupBegin), CharCounter + 1, 1)
            If thischar = "=" Then
                numDataBytes = numDataBytes - 1
                thisData = 0
            Else
                thisData = InStr(1, Base64, thischar, vbBinaryCompare) - 1
            End If
            nGroup = 64 * nGroup + thisData
        Next
        'Hex divise l'entier long en 6 groupes de 4 bits
        nGroup = Hex(nGroup)
        'Ajout des zéros de tête
        nGroup = String(6 - Len(nGroup), "0") & nGroup
        'Conversion de l'entier en héxa en 3 caractères
        qq = GetTickCount
        pOut = pOut & Left(Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
        Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
        Chr(CByte("&H" & Mid(nGroup, 5, 2))), numDataBytes)
        'concatenation avec la chaîne de sortie mais si le temps de l'opération dépasse 1ms on purge la variable pout
        'géneralement vu la taille des fichiers attachés on a pas besoin de + de 2 variables "purgeables"
        If GetTickCount - qq > 1 Then
            rr = GetTickCount
            zout = zout & pOut
            If GetTickCount - rr > 1 Then
                sOut = sOut & zout
                zout = ""
            End If
            pOut = ""
            DoEvents
        End If
    Next
    Base64Decode = sOut & zout & pOut
End Function

ce code fonctionne avec Excel uniquement avec des Image.jpg, mais les Image.png sont correctement décodées.
@+JP

mjpmjp · Answer

bonjour a tous
juste pour indiquer une piste avec encodage Base64
en fait les codes de l'image que je place dans 
un fichier.txt que je renome fichier.b64
ce fichier.b64 pourait etre traité avec WinZip ?
je poursuit mes recherches.
+JP

mjpmjp · Answer

bonjour a tous
Sa fonctionne!!! 
Quand on renomme en fichier.b64, le fichier prend l'icone de WinZip, un fichier décompressé apparait UNKNOWN.001 un fois renomme en UNKNOWN.jpg on a une image.jpg.
prochaine étape
trouver les fonctions WinZip en VB pour traiter directement par code...
@+JP

Extraire une image.jpg d'une feuille.mht

3 réponses

Votre réponse

Discussions similaires