Comment obtenir le lien direct depuis une url avec un identifiant de session par vbscript ?

**hackoofr** · 25/03/2018, 13h26

Ce code marche très bien pour télécharger le fichier mb3-setup-consumer-3.4.4.2398-1.0.322-1.0.4470.exe
j'ai obtenu le lien direct depuis le (header) = (En-tête) depuis cette URL = "https://downloads.malwarebytes.com/file/mb3/"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Mon problème se résume dans cette URL que je n'ai pas encore trouvé une solution pour récupérer le lien direct ?
URL = https://download.toolslib.net/download/file/1/1388
Quand je fais copier et coller dans le navigateur, j'obtiens bien le nom de fichier par le downloader Internet Downloader Manager comme : adwcleaner_7.0.8.0.exe despuis une URL temporaire qui utilise une session ID temporaire comme ceci : https://download.toolslib.net/downlo...NY8MWKTACBWKqe
Donc ce que j'ai remarqué que l'url est dynamique avec une session ID temporaire pour chaque requête et pour chaque utilisteur URL?s=[Session ID Dynamique]
Donc ma question comment faire par vbscript pour récupérer le nom de fichier à télécharger dans cette situation ?
Merci de votre aide !

**ABOAT** · 25/03/2018, 18h40

Salut hackoo voici une solution, (via InternetExplorer hide)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
'Hackoo
On Error Resume Next
Dim IE,LienDL
Set IE = Wscript.CreateObject("InternetExplorer.Application")
IE.Visible = 0
IE.navigate "https://toolslib.net/downloads/finish/1/1388/" 
While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend
WScript.Sleep 200
LienDL = IE.document.all.namedItem("downloadLink")
IE.Quit
MsgBox "Le lien de téléchargement : " & LienDL

Par contre ça passe par InternetExplorer (mode caché) je ne sais pas comment faire sans passer par se chemin

**hackoofr** · 25/03/2018, 20h24

et

@ABOAT pour votre réponse

Oui ça me donne bien l'url dynamique avec votre méthode, mais le problème c'est comment depuis ce lien dynamique, je peux trouver le nom de fichier à télécharger ? c'est ça mon problème !

**hackoofr** · 25/03/2018, 21h00

J'ai enfin trouvé la solution pour obtenir et télécharger un fichier depuis un lien dynamique et ceci grâce a ce membre Jay dans cette discussion

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**hackoofr** · 03/04/2018, 05h05

Juste, une petite démonstration de l'utilisation de ce vbscript dans un fichier batch

Security_Tools_Downloader_by Hackoo.bat

Comment obtenir le lien direct depuis une url avec un identifiant de session par vbscript ?

VBScript

Discussions similaires

Partager

Partager