[VBS] Tester l'accès a une page web

Version imprimable

Bonjour,
Je reviens vers vous encore une foi, je cherche a tester l'accessibilité a une page web (accessible ou code 404), après plusieurs recherche sur le net voila ce que j'ai trouvé, [VBS & winsock] Test d'une page WEB

Mais problème il ne fonction pas (et je suis nul en vbs) toute aide sera la bienvenue merci d'avance.

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
35
36
37
38
39
40
41
42
43
44
 
'Script tester une URL
 
'Constante de script
Const S_REMOTE_HOST = "10.169.66.XX"
Const S_REMOTE_PORT = "80"
Const url = "/main/index.html"
Const MSWS = "mswinsock.winsock"
 
'Objet socket
Dim oSck
 
'Compteur
Dim i
 
'Création de l'objet socket
Set oSck = CreateObject(MSWS)
 
'Initialisation des paramètres de connexion
oSck.RemoteHost = S_REMOTE_HOST
oSck.RemotePort = S_REMOTE_PORT
 
'Connexion au serveur
oSck.Connect
 
'Attente de réponse du serveur
While(oSck.State <> 7 And i < 1000)
    WScript.Sleep 10
    i=i+1
Wend
'Si la connexion est KO
If i >= 1000 Then
    msgbox "NOK"
Else
'Je ne comprend pas la ligne suivante
    oSck.SendData("GET " & url & "HTTP:/1.1")
    msgbox "ok "
End If
 
'Fermeture de la socket
oSck.Close
 
'Libération de la mémoire
Set oSck = Nothing

:salut:
D'après ceci : Retrieve http status code

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
'----------------------------------------------------------------------------------------------------------------------------  
'Script Name : EnumerateURLStatus.vbs           
'Author      : Matthew Beattie           
'Created     : 16/02/09         
'Description : This script enumerates the status code of a URL.        
'----------------------------------------------------------------------------------------------------------------------------  
'Initialization  Section           
'----------------------------------------------------------------------------------------------------------------------------  
Option Explicit        
Dim objFSO, scriptBaseName        
'----------------------------------------------------------------------------------------------------------------------------  
'Main Processing Section        
'----------------------------------------------------------------------------------------------------------------------------  
On Error Resume Next       
   Set objFSO     = CreateObject("Scripting.FileSystemObject")        
   scriptBaseName = objFSO.GetBaseName(Wscript.ScriptFullName)        
   ProcessScript        
   If Err.Number <> 0 Then       
      Wscript.Quit        
   End If       
On Error Goto 0        
'----------------------------------------------------------------------------------------------------------------------------  
'Name       : ProcessScript -> Primary Function that controls all other script processing.           
'Parameters : None          ->            
'Return     : None          ->            
'----------------------------------------------------------------------------------------------------------------------------  
Function ProcessScript        
   Dim urls, url, urlStatus  
   urls = Array("http://www.google.com.au","http://www.google.com","http://www.google.com/nopage.html")     
   For Each url In urls     
      If Not GetURLStatus(url, urlStatus) Then 
         MsgBox "Failed to retrive the URL status for " & url, vbCritical, scriptBaseName        
      Else 
         Select Case urlStatus  
            Case 404  
               MsgBox "The status of the URL " & url & " is " & urlStatus, vbCritical, scriptBaseName  
            Case Else 
               MsgBox "The status of the URL " & url & " is " & urlStatus, vbInformation, scriptBaseName  
         End Select 
      End If      
   Next    
End Function 
'----------------------------------------------------------------------------------------------------------------------------  
'Name       : GetURLStatus -> Enumerates the status code of a URL.          
'Parameters : url          -> String containing the URL of the web page to enumerate.        
'           : urlStatus    -> Input/Output : Integer containing the url status code number.        
'Return     : GetURLStatus -> Returns True and the status code of the URL otherwise returns False.        
'----------------------------------------------------------------------------------------------------------------------------  
Function GetURLStatus(url, urlStatus)  
   Dim objWinHttp  
   Dim userAgentString, sslErrorIgnoreFlags  
   Dim enableRedirects, enableHttpsToHttpRedirects  
   GetURLStatus               = False 
   urlStatus                  = "" 
   userAgentString            = "http_requester/0.1" 
   sslErrorIgnoreFlags        = 13056  
   enableRedirects            = True 
   enableHttpsToHttpRedirects = True 
   On Error Resume Next 
      Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")  
      If Err.Number <> 0 Then 
         DisplayError "Creating WinHttp Object" 
         Exit Function 
      End If 
      objWinHttp.Open "GET", url  
      objWinHttp.Option(0)  = userAgentString  
      objWinHttp.Option(4)  = sslErrorIgnoreFlags  
      objWinHttp.Option(6)  = enableRedirects  
      objWinHttp.Option(12) = enableHttpsToHttpRedirects  
      objWinHttp.Send("")  
      If Err.Number <> 0 Then 
         DisplayError "Enumerating URL Status" 
         Exit Function 
      End If 
   On Error GoTo 0  
   urlStatus    = CInt(objWinHttp.Status)  
   GetURLStatus = True 
End Function   
'----------------------------------------------------------------------------------------------------------------------------  
'Name       : PromptError -> Prompts user with the error message and information from the Error Object.           
'Parameters : None        ->            
'Return     : PromptError ->            
'----------------------------------------------------------------------------------------------------------------------------  
Function PromptError(errorMessage)     
   MsgBox Err.Number & " Hex(" & Hex(Err.Number) & ") " & errorMessage & ". " & Err.Description     
End Function    
'----------------------------------------------------------------------------------------------------------------------------

Citation:

Envoyé par hackoofr

:salut:
D'après ceci : Retrieve http status code

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
'----------------------------------------------------------------------------------------------------------------------------  
'Script Name : EnumerateURLStatus.vbs           
'Author      : Matthew Beattie           
'Created     : 16/02/09         
'Description : This script enumerates the status code of a URL.        
'----------------------------------------------------------------------------------------------------------------------------  
'Initialization  Section           
'----------------------------------------------------------------------------------------------------------------------------  
Option Explicit        
Dim objFSO, scriptBaseName        
'----------------------------------------------------------------------------------------------------------------------------  
'Main Processing Section        
'----------------------------------------------------------------------------------------------------------------------------  
On Error Resume Next       
   Set objFSO     = CreateObject("Scripting.FileSystemObject")        
   scriptBaseName = objFSO.GetBaseName(Wscript.ScriptFullName)        
   ProcessScript        
   If Err.Number <> 0 Then       
      Wscript.Quit        
   End If       
On Error Goto 0        
'----------------------------------------------------------------------------------------------------------------------------  
'Name       : ProcessScript -> Primary Function that controls all other script processing.           
'Parameters : None          ->            
'Return     : None          ->            
'----------------------------------------------------------------------------------------------------------------------------  
Function ProcessScript        
   Dim urls, url, urlStatus  
   urls = Array("http://www.google.com.au","http://www.google.com","http://www.google.com/nopage.html")     
   For Each url In urls     
      If Not GetURLStatus(url, urlStatus) Then 
         MsgBox "Failed to retrive the URL status for " & url, vbCritical, scriptBaseName        
      Else 
         Select Case urlStatus  
            Case 404  
               MsgBox "The status of the URL " & url & " is " & urlStatus, vbCritical, scriptBaseName  
            Case Else 
               MsgBox "The status of the URL " & url & " is " & urlStatus, vbInformation, scriptBaseName  
         End Select 
      End If      
   Next    
End Function 
'----------------------------------------------------------------------------------------------------------------------------  
'Name       : GetURLStatus -> Enumerates the status code of a URL.          
'Parameters : url          -> String containing the URL of the web page to enumerate.        
'           : urlStatus    -> Input/Output : Integer containing the url status code number.        
'Return     : GetURLStatus -> Returns True and the status code of the URL otherwise returns False.        
'----------------------------------------------------------------------------------------------------------------------------  
Function GetURLStatus(url, urlStatus)  
   Dim objWinHttp  
   Dim userAgentString, sslErrorIgnoreFlags  
   Dim enableRedirects, enableHttpsToHttpRedirects  
   GetURLStatus               = False 
   urlStatus                  = "" 
   userAgentString            = "http_requester/0.1" 
   sslErrorIgnoreFlags        = 13056  
   enableRedirects            = True 
   enableHttpsToHttpRedirects = True 
   On Error Resume Next 
      Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")  
      If Err.Number <> 0 Then 
         DisplayError "Creating WinHttp Object" 
         Exit Function 
      End If 
      objWinHttp.Open "GET", url  
      objWinHttp.Option(0)  = userAgentString  
      objWinHttp.Option(4)  = sslErrorIgnoreFlags  
      objWinHttp.Option(6)  = enableRedirects  
      objWinHttp.Option(12) = enableHttpsToHttpRedirects  
      objWinHttp.Send("")  
      If Err.Number <> 0 Then 
         DisplayError "Enumerating URL Status" 
         Exit Function 
      End If 
   On Error GoTo 0  
   urlStatus    = CInt(objWinHttp.Status)  
   GetURLStatus = True 
End Function   
'----------------------------------------------------------------------------------------------------------------------------  
'Name       : PromptError -> Prompts user with the error message and information from the Error Object.           
'Parameters : None        ->            
'Return     : PromptError ->            
'----------------------------------------------------------------------------------------------------------------------------  
Function PromptError(errorMessage)     
   MsgBox Err.Number & " Hex(" & Hex(Err.Number) & ") " & errorMessage & ". " & Err.Description     
End Function    
'----------------------------------------------------------------------------------------------------------------------------

:merci: hackoofr,
Je test cette après midi (très intéressant)

23/10/2015, 09h51
positrons

Salut hackoofr et un grand :merci: pour ton aide c'est exactement se que je cherche, j'ai romodelé le code pour mais besoin et ça fonctionne parfaitement, problème résolu :ptdr:

:merci: encore une fois.