Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for lookupurl.vbs

(view source code of lookupurl.vbs as plain text) 

  1. Option Explicit
  2.  
  3. Dim blnQuiet, intArgs, objRE, strURL
  4.  
  5. blnQuiet = False
  6. intArgs  = 0
  7. strURL   = ""
  8.  
  9. Set objRE = New RegExp
  10. objRE.Pattern    = "^[fehilpst]{3,5}://"
  11. objRE.IgnoreCase = False
  12.  
  13. With WScript.Arguments
  14. 	If .Unnamed.Count = 1 Then
  15. 		strURL = .Unnamed(0)
  16. 		If objRE.Test( strURL ) Then
  17. 			intArgs = intArgs + 1
  18. 		End If
  19. 	End If
  20. 	If .Named.Exists("Q") Then
  21. 		blnQuiet = True
  22. 		intArgs  = intArgs + 1
  23. 	End If
  24. 	If intArgs <> .Count Then Syntax
  25. 	If strURL  =  ""     Then Syntax
  26. End With
  27.  
  28.  
  29. Lookup strURL
  30.  
  31.  
  32. Sub Lookup( myURL )
  33. 	Dim objHTTP, strResult
  34.  
  35. 	Const WinHttpRequestOption_UserAgentString = 0
  36. 	Const WinHttpRequestOption_URL = 1
  37. 	Const WinHttpRequestOption_URLCodePage = 2
  38. 	Const WinHttpRequestOption_EscapePercentInURL = 3
  39.  
  40. 	Const WinHTTPRequestError_Timeout = &H80072EE2
  41.  
  42. 	On Error Resume Next
  43. 	Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  44. 	objHTTP.Open "GET", myURL, False
  45. 	objHTTP.SetTimeouts 100, 100, 100, 100
  46. 	objHTTP.Send
  47. 	objHTTP.WaitForResponse 100
  48. 	' Ignore timeouts, as we induce them by setting very "impatient" timeout values
  49. 	If Err.Number <> 0 And Err.Number <> WinHTTPRequestError_Timeout Then
  50. 		WScript.Echo "Error 0x" & Hex( Err.Number ) & vbTab & Err.Description
  51. 	Else
  52. 		strResult = objHTTP.Option( WinHttpRequestOption_URL )
  53. 		If strResult = myURL Then
  54. 			If blnQuiet Then
  55. 				WScript.Echo strResult
  56. 			Else
  57. 				WScript.Echo "Target URL :  " & strResult
  58. 			End If
  59. 		Else
  60. 			If Not blnQuiet Then WScript.Echo "Redirected :  " & myURL
  61. 			Lookup strResult
  62. 		End If
  63. 	End If
  64. 	Set objHTTP = Nothing
  65. 	On Error Goto 0
  66. End Sub
  67.  
  68.  
  69. Sub Syntax
  70. 	Dim strMsg
  71. 	strMsg = vbCrLf _
  72. 	       & "LookupURL.vbs,  Version 1.00" _
  73. 	       & vbCrLf _
  74. 	       & "Display the destination URL for a redirected URL" _
  75. 	       & vbCrLf & vbCrLf _
  76. 	       & "Usage:    CSCRIPT.EXE // NoLogo LOOKUPURL.VBS  url  [ /Q ]" _
  77. 	       & vbCrLf & vbCrLf _
  78. 	       & "Where:                   url   is the redirected URL to be investigated" _
  79. 	       & vbCrLf _
  80. 	       & "                         /Q    displays the destination URL only" _
  81. 	       & vbCrLf & vbCrLf _
  82. 	       & "Example:  LOOKUPURL.VBS http://robvanderwoude.com/wshexamples_l.html"_
  83. 	       & vbCrLf _
  84. 	       & "Returns:  Redirected :  http://robvanderwoude.com/wshexamples_l.html" _
  85. 	       & vbCrLf _
  86. 	       & "          Target URL :  http://www.robvanderwoude.com/wshexamples.php?fc=l" _
  87. 	       & vbCrLf & vbCrLf _
  88. 	       & "Written by Rob van der Woude" _
  89. 	       & vbCrLf _
  90. 	       & "http://www.robvanderwoude.com"
  91. 	WScript.Echo strMsg
  92. 	WScript.Quit 1
  93. End Sub
  94.  

page last modified: 2024-04-16; loaded in 0.0185 seconds