TESTEUR DE LISTE D'URLS V 4.3

Commentaire de Patrice99 le 30/11/2005 09:17:57

Ca serait super si la liste d'URL pouvait être construite à partir d'une page web existante (il suffit de lire la collection prévue à cet effet), comme ca on pourrait vérifier les liens cassés d'une page : il y a beaucoup de sites qui le font, mais je n'ai pas encore trouvé le site parfait pour cela, permettant de vérifier tous les liens d'un site perso, avec une bonne ergonomie.

Commentaire de Patrice99 le 01/12/2005 08:18:45

Avec le controle WebBrowser, une fois que tu as l'evenement fin de navigation, la collection des liens de la page est déjà faite, mais peut être que quelqu'un pourra indiquer un lien vers le code le plus simple possible pour cela (on peut surement se passer du WebBrowser), il suffit d'attendre un peu.

Commentaire de Sechaud le 02/12/2005 09:32:08

Merci Zootella pour ta participation.J'ai récupéré ton logiciel mais je ne l'ai pas encore testé.Je travaille dur sur la version 2 de mon Testeur d'URL's.
Ce qui me chagrine dans ton source, c'est l'emploi de la base de registre.
J''ai testé ce mini source qui extrait les URL's
d'un site.Un list.box, un text.box et un bouton suffisent.
Il marche mais ouvre trop de fenêtres.
Voici:
Private Sub Command1_Click()
Dim codSrc As String

Adresse = Chr(34) & Text1.Text & Chr(34)
Inet1.URL = Text1.Text
codesrc = Inet1.OpenURL

Form1.WindowState = 1 'On minimise la fenêtre
'On lance la page avec un shell et on ouvre l'Url dans Iexplorer

Shell "explorer " & Adresse, vbNormalFocus

'on extrait chaque url trouvée dans le code src et on lance la page avec un shell
Dim Depart As Long
Dim Fin As Long
Dim debut As Long
debut = 1
Depart = InStr(debut, codesrc, "http://")

Dim F As Integer
For F = 0 To 100 'Je limite à 100 les recherches
DoEvents
F = F + 1
Fin = InStr(Depart, codesrc, Chr(34))
List1.AddItem Mid(codesrc, Depart, Fin - Depart)
Shell "explorer " & Mid(codesrc, Depart, Fin - Depart), vbNormalFocus
debut = Fin
Depart = InStr(debut, codesrc, "http://")
Next F


End Sub

Commentaire de Sechaud le 04/12/2005 17:26:50

Bonjour Julien
C'est msinet.ocx qui fait tout le boulot.

Il connecte le PC à l'adresse Internet qu'on lui donne et il permet de lire des infos en retour.
  Fais apparaître la fenêtre d'affichage en cochant la CheckBox et tu les verras.

Si ces infos n'arrivent pas, on peut en conclure que le serveur n'existe plus ou qu'il ne répond pas au moment du test.
Regarde le code du bouton 6 que je t'ai un peu plus commenté.

Private Sub Command6_Click() 'Test d'une URL
Dim hdr, posCr
    Text1.Text = ""
    On Error GoTo Probleme
   If strUrl.Text = "" Then 'strUrl.Text contientl'URL
     MsgBox "Vous n'avez pas séléctionné d'URL!", 48, "INFO"
     GoTo Sortie
     End If
    
     cdeRep.Text = "" 'On efface la case réponse

    Inet1.URL = strUrl 'On lui dit l'URL à ouvrir
    
    Inet1.OpenURL 'Il reçoit l'ordre d'ouvrir
    Text1.Text = Inet1.ResponseInfo

     'On traite la répons éventuelle
    If vtData = "" Then
        hdr = Inet1.GetHeader

        If Check1.Value = 1 Then 'Si coché on affiche les infos dans Text1.Text
             Text1.Visible = True
             Text1.Text = hdr
       End If
      
        posCr = InStr(hdr, vbCrLf)
        hdr = Left(hdr, posCr - 1)
        
        If Inet1.RequestTimeout > 100 And hdr = "" Then
                GoTo Sortie
        End If
        
    Else
        hdr = vtData
    End If
    
    cdeRep = hdr
   GoTo Sortie
Probleme:
   cdeRep = "Le serveur ne répond pas"
Sortie:
End Sub

En espéranr avoir répondu à ta question.

Commentaire de JULIEN0 le 05/12/2005 18:38:05

merci

Commentaire de coolstef le 28/02/2006 18:22:26

J'ai rajouté un petit bricolage (trouvé sur vbfrance pour obtention de l'heure systeme...) qui permet d'éviter les plantages si le site ne repond pas ou renvoie sur des redirection mal foutues et qui permet de sortir une mesure (pas forcemment correct en ms) du temps nécessaire pour l'accés. Je rajoute au niveau du label probleme un inet.cancel pour mettre fin de facon forcée à la session : ca optimise pas, mais ca stabilise...

    For B = 0 To Nbligne - 1
        cdeRep.Text = "" 'On efface la case réponse
        Inet1.URL = Tbl(B)

    'debut modif*******************************************************
        
    Dim TimeSys As SYSTEMTIME
    GetSystemTime TimeSys
    Dim Hours As Long
    Inet1.Cancel
        
    Hours = (TimeSys.wMinute + (TimeSys.wHour * 60))
    ActionTime = TimeSys.wMilliseconds + (TimeSys.wSecond + Hours * 60) * 1000
    
    test = Inet1.OpenURL
  
    GetSystemTime TimeSys
    Hours = (TimeSys.wMinute + (TimeSys.wHour * 60))
    ActionTime = Abs(ActionTime - (TimeSys.wMilliseconds + (TimeSys.wSecond + Hours * 60) * 1000))
    
    If ActionTime > 15000 Then
        typeerreur = " - TIMEOUT"
        GoTo Probleme
    End If
    
    End If
    If test = "" Then
        GoTo Probleme
    End If
    

Commentaire de NOXteam le 28/08/2006 14:06:06

comment se debrouiller sans l'exe

Commentaire de Renfield le 15/11/2007 15:18:49 administrateur CS

il suffit d'ouvrir le fichier VBP et de générer un nouvel EXE

VbFrance est un site du réseau CodeS-SourceS.
site spécialisé dans la programmation (ici Visual Basic 6.0)... vous ne trouverez donc ici que des codes sources, et non des exe touts prets.

Commentaire de martinegr le 16/11/2007 11:13:32

Ok j'ai réussi à réaliser l'exe.
Par contre, ce logiciel fonctionne correctement sur mon poste mais sur le poste d'une autre personne à la fin du test des urls, lorsqu'on veut enregistrer les URLs Valides et Invalides on obtient un message "Vous n'avez rien à sauvegarder". Avez-vous déjà rencontré ce pb ?

Commentaire de gargamail51 le 30/11/2007 18:36:17

Bonjour

Tout d'abord merci pour ce code !

Par contre je ne comprend pas l'utilité d'ouvrir une page Internet pour chaques liens trouvés par le sniffer ! pourquoi ne pas tester tout simplement leurs validité de la même maniére que vous le faite pour la page principale ?