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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
| Option Explicit
Dim Title,Base_Link,Dynamic_Link,Save2File
Title = "Download a file with a dynamic link by Hackoo 2018"
Base_Link = "https://download.toolslib.net/download/file/1/1388"
Dynamic_Link = Extract_Dynamic_Link(GetDataFromURL(base_link,"Get", ""))
MsgBox "The Dynamic Link is = "& Dynamic_Link & vbcrlf & vbcrlf &_
"Response of The Dynamic Link is : "& vbcrlf & GetHeaderLocation(Dynamic_Link) & vbCrlf & vbCrlf &_
"Extracted FileName is = " & GetFileName(GetHeaderLocation(Dynamic_Link)),vbInformation,Title
Save2File = GetFileName(GetHeaderLocation(Dynamic_Link))
Call Download(Dynamic_Link,Save2File)
MsgBox "The download of the file : "& Save2File & vbCrlf &_
"is Completed !",vbInformation,Title
'***********************************************************************************************
Function GetHeaderLocation(URL)
Const WHR_EnableRedirects = 6
Dim h,GetLocation
On Error Resume Next
Set h = CreateObject("WinHttp.WinHttpRequest.5.1")
h.Option(WHR_EnableRedirects) = False 'disable redirects
h.Open "HEAD", URL , False
h.Send()
GetLocation = h.GetResponseHeader("Content-Disposition") 'an error occurs if not exist
If Err = 0 Then
GetHeaderLocation = GetLocation
Else
GetHeaderLocation = Err.Description
End If
End Function
'***********************************************************************************************
Function Extract_Dynamic_Link(Data)
Dim regEx, Match, Matches,Dynamic_Link
Set regEx = New RegExp
regEx.Pattern = Base_Link & "\?s=[^""]*"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(Data)
For Each Match in Matches
Dynamic_Link = Match.Value
Next
Extract_Dynamic_Link = Dynamic_Link
End Function
'***********************************************************************************************
Function GetDataFromURL(strURL, strMethod, strPostData)
Dim lngTimeout
Dim strUserAgentString
Dim intSslErrorIgnoreFlags
Dim blnEnableRedirects
Dim blnEnableHttpsToHttpRedirects
Dim strHostOverride
Dim strLogin
Dim strPassword
Dim strResponseText
Dim objWinHttp
lngTimeout = 59000
strUserAgentString = "http_requester/0.1"
intSslErrorIgnoreFlags = 13056 ' 13056: ignore all err, 0: accept no err
blnEnableRedirects = True
blnEnableHttpsToHttpRedirects = True
strHostOverride = ""
strLogin = ""
strPassword = ""
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
objWinHttp.Open strMethod, strURL
If strMethod = "POST" Then
objWinHttp.setRequestHeader "Content-type", _
"application/x-www-form-urlencoded"
End If
If strHostOverride <> "" Then
objWinHttp.SetRequestHeader "Host", strHostOverride
End If
objWinHttp.Option(0) = strUserAgentString
objWinHttp.Option(4) = intSslErrorIgnoreFlags
objWinHttp.Option(6) = blnEnableRedirects
objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
If (strLogin <> "") And (strPassword <> "") Then
objWinHttp.SetCredentials strLogin, strPassword, 0
End If
On Error Resume Next
objWinHttp.Send(strPostData)
If Err.Number = 0 Then
If objWinHttp.Status = "200" Then
GetDataFromURL = objWinHttp.ResponseText
Else
GetDataFromURL = "HTTP " & objWinHttp.Status & " " & _
objWinHttp.StatusText
End If
Else
GetDataFromURL = "Error " & Err.Number & " " & Err.Source & " " & _
Err.Description
End If
On Error GoTo 0
Set objWinHttp = Nothing
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(Data)
Dim regEx, Match, Matches,FileName
Set regEx = New RegExp
regEx.Pattern = "\x22(\w.*)\x22"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(Data)
For Each Match in Matches
FileName = Match.subMatches(0)
Next
GetFileName = FileName
End Function
'*********************************************************************************************** |
