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
'---------------------------------------------------------------------------------------------------------------------------- |
Partager