Detecter le poids d'une image avec l'objet DOM

Version imprimable

19/07/2006, 21h09
crimsonPhantom

Detecter le poids d'une image avec l'objet DOM

Bonjour a tous,

Voici mon petit questionnement. Est-ce possible de connaitre le poids d'une image d'un site web avec les bibliotheques Microsoft HTML Object Library et Microsoft Internet Controls de VB6? :?
Si la reponse est non, est-ce qu'il existe une maniere autre que le download de l'image puis de son analyse lorsqu'elle se trouve sur le disque dur?

merci pour toutes reponses :)

bonsoir

j'espere que cet exemple pourra t'aider

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Sub CommandButton3_Click()
    '********************************************
    'boucler sur toutes les images d'une page Web
    'pour recuperer l'adresse et les dimensions
    '********************************************
    'testé avec WinXP & Excel2002
    'nécéssite d'activer la référence Microsoft HTML Objects Library
    'nécéssite d'activer la référence Microsoft Internet Controls
    Dim IE As InternetExplorer
    Dim maPageHtml As HTMLDocument
    Dim imgHtml As HTMLImg
    Dim i As Integer
 
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
 
    IE.navigate "http://www.developpez.com"
        Do Until IE.readyState = READYSTATE_COMPLETE
        DoEvents
    Loop 'attend la fin du chargement pour continuer la procedure
 
    Set maPageHtml = IE.document
    'compte le nombre d'images dans la page
    Debug.Print "nombre d'images dans la page : " & maPageHtml.images.Length
 
    For i = 0 To maPageHtml.images.Length - 1 'boucle sur les images
        Set imgHtml = maPageHtml.images.Item(i)
 
        Debug.Print imgHtml.src 'adresse image
        Debug.Print imgHtml.fileSize & " octets"
        Debug.Print imgHtml.Width 'largeur image
        Debug.Print imgHtml.Height 'hauteur image
    Next i
End Sub

bonne soiree
michel

19/07/2006, 22h00
crimsonPhantom

Code:

Debug.Print imgHtml.fileSize & " octets"

ahh merci! je cherchais comme un debile dans les proprietes sans rien trouve!

;)

hmm J'aurai encore besoin d'une intervention...:?

la propriete fileSize de mon objet de type HTMLImg ne me retourne que -1 peut importe l'image et son poids reel...

Code:

1
2
3
4
5
6
7
8
9
10
11
            If objHtml.tagName = "IMG" Then
                Set objIMG = objHtml
                Debug.Print objIMG.fileSize & " octets" ' ne me retourne que -1 ??
                If objIMG.Width = "100" And objIMG.Height = "67" And _
                    InStr(1, objIMG.src, "images.lendingtree.com", vbTextCompare) > 0 Then
                    If objIMG.fileSize < 4500 Then ' ici ca passe toujours...:( 
                        strImage = objIMG.src
                    End If
                End If
            End If

Est-ce que je fais quelque chose de bizarre?

20/07/2006, 16h55
SilkyRoad

bonjour

c'est difficile de répondre sans voir l'ensemble de ta procédure

bon apres midi
michel

voici la fonction complete...

la difference notable par rapport a ton code c'est la boucle je crois. :?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Private Sub ExtraireInfoImage(url As String)
    Dim doc As HTMLDocument
    Dim objHtml as Variant
    Dim objIMG As HTMLImg
 
    Set doc = getHTMLDocument(url)
    Call WaitForReadyState
    For Each objHtml In doc.All
            DoEvents
 
            If objHtml.tagName = "IMG" Then
                Set objIMG = objHtml
                Debug.Print objIMG.fileSize & " octets" ' ne me retourne que -1 ??
                If objIMG.Width = "100" And objIMG.Height = "67" And _
                    InStr(1, objIMG.src, "images.lendingtree.com", vbTextCompare) > 0 Then
                    If objIMG.fileSize < 4500 Then ' ici ca passe toujours...:( 
                        collection_image.add(objIMG.src)
                    End If
                End If
            End If
    Next objHtml
    set doc = nothing
End Sub

bonjour

Je n'ai pas testé la macro car tu ne montres pas les sous procédures getHTMLDocument et WaitForReadyState

A tout hasard, tu peux essayer cette adaptation

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub ExtraireInfoImage(url As String)
    Dim doc As HTMLDocument
    Dim objIMG As HTMLImg
 
    Set doc = getHTMLDocument(url)
    Call WaitForReadyState
 
    For Each objIMG In doc.images
            DoEvents
 
            Debug.Print objIMG.fileSize & " octets"
 
            If objIMG.Width = 100 And objIMG.Height = 67 And _
               InStr(1, objIMG.src, "images.lendingtree.com", vbTextCompare) > 0 Then
                If objIMG.fileSize < 4500 Then collection_image.Add (objIMG.src)
            End If
    Next objIMG
    Set doc = Nothing
End Sub

bon apres midi
michel