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
| Option Explicit
Const Title = "Get Header Location"
Const WHR_EnableRedirects = 6
Dim URL,Result,DirectURL,Save2File
URL = "https://downloads.malwarebytes.com/file/mb3/"
Result = InputBox("Copy and paste your link here to get the response header",Title,URL)
If IsEmpty(Result) or Result = "" Then Wscript.Quit(1)
DirectURL = InputBox("Result of Direct URL is :",Title,GetHeaderLocation(Result))
If IsEmpty(DirectURL) or DirectURL = "" Then Wscript.Quit(1)
Save2File = GetFileName(DirectURL)
Call Download(DirectURL,Save2File)
'-------------------------------------------------------------------------------------
Function GetHeaderLocation(URL)
On Error Resume Next
Dim h,GetLocation
Set h = CreateObject("WinHttp.WinHttpRequest.5.1")
h.Option(WHR_EnableRedirects) = False 'disable redirects
h.Open "HEAD", URL , False
h.Send()
GetLocation = h.GetResponseHeader("Location") 'an error occurs if not exist
If Err = 0 Then
GetHeaderLocation = GetLocation
Else
GetHeaderLocation = Err.Description
End If
End Function
'-------------------------------------------------------------------------------------
Sub Download(URL,Save2File)
Dim File,Line,BS,ws
On Error Resume Next
Set File = CreateObject("WinHttp.WinHttpRequest.5.1")
File.Open "GET",URL, False
File.Send()
If err.number <> 0 then
Line = Line & vbcrlf & "Error Getting File"
Line = Line & vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & vbcrlf &_
err.description
Line = Line & vbcrlf & "Source " & err.source
MsgBox Line,vbCritical,"Error getting file"
Err.clear
wscript.quit
End If
If File.Status = 200 Then ' File exists and it is ready to be downloaded
Set BS = CreateObject("ADODB.Stream")
Set ws = CreateObject("wscript.Shell")
BS.type = 1
BS.open
BS.Write File.ResponseBody
BS.SaveToFile Save2File, 2
ElseIf File.Status = 404 Then
MsgBox "File Not found : " & File.Status,vbCritical,"Error File Not Found"
Else
MsgBox "Unknown Error : " & File.Status,vbCritical,"Error getting file"
End If
End Sub
'---------------------------------------------------------------------------------------
Function GetFileName(URL)
Dim ArrFile
ArrFile = Split(URL,"/")
GetFileName = ArrFile(UBound(ArrFile))
End Function
'--------------------------------------------------------------------------------------- |
Partager