• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 65
  • Last Modified:

How to get the direct link from url that have a session ID by vbscript?

I'm trying to get the direct link from url, so i use this function to provide me the header location and for this example it works fine :
    Option Explicit
    Const Title = "Get Header Location"
    Const WHR_EnableRedirects = 6
    Dim URL,Result 
    URL = "https://downloads.malwarebytes.com/file/mb3/"
    Result = InputBox("Copy and Paste your link here to get the response header",Title,URL)
    MsgBox GetHeaderLocation(Result),vbInformation,Title
    '-------------------------------------------------------------------------------------
    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
    '-------------------------------------------------------------------------------------

Open in new window

but when i try with this url
https://download.toolslib.net/download/file/1/1388?s=EeATC00Djuzo7gfQUxBBdtqcm3VUFamy
it give me this message :
The requested header was not found
So my question is How to get the direct link from this url ?
EDIT :
What i mean by direct url is how to get with .exe in the end.
I know if i paste into browser it works and let me download as adwcleaner_7.0.8.0.exe but how can manage that with vbscript if i want to download it by the script itself.
So i need a direct link !
Hope you understand what i mean now !
For example in my first URL = "https://downloads.malwarebytes.com/file/mb3/
I got as header location like that in direct link : DirectLink = https://data-cdn.mbamupdates.com/web/mb3-setup-consumer/mb3-setup-consumer-3.4.4.2398-1.0.322-1.0.4420.exe
Thank you
0
Hackoo
Asked:
Hackoo
  • 5
  • 3
2 Solutions
 
ste5anSenior DeveloperCommented:
Must be some specific error from you. Works here.
0
 
Bill PrewCommented:
Worked for me here too, no error and returned the following URL after downloading it.  Were you looking for a link before the download?

https://toolslib.net/downloads/finish/1/1388/


»bp
0
 
HackooAuthor Commented:
Please check my last edit !
Hope it is more clearer now !
0
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

 
Bill PrewCommented:
I don't think you are going to be able to do that.  The hosting website isn't exposing the actual file link, rather a link to a "page" on their site that initiates the download automatically.  It doesn't expose any URL that would let you reference the EXE directly.

What's the difference though, the end result is to download the file right, so what do you care what the URL actually contains, as long as when you go to that URL address it sends you the file?


»bp
0
 
HackooAuthor Commented:
I'm still stuck with this code :
Option Explicit
Const Title = "Get Header Location"
Const WHR_EnableRedirects = 6
Dim URL,Result,DirectURL,Save2File 
URL = "https://download.toolslib.net/download/file/1/1388/"
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
'---------------------------------------------------------------------------------------

Open in new window

0
 
HackooAuthor Commented:
I got an answer here thanks to the member Jay that put me in the right direction !
Download_File_From_Dynamic_Link.vbs
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
'***********************************************************************************************

Open in new window

Download_File_From_Dynamic_Link.vbs
0
 
Bill PrewCommented:
So I see how that gives you the name of the file that will be downloaded, but where is the full URL to that file, as you asked for in the question originally?

For example in my first URL = "https://downloads.malwarebytes.com/file/mb3/
I got as header location like that in direct link : DirectLink = https://data-cdn.mbamupdates.com/web/mb3-setup-consumer/mb3-setup-consumer-3.4.4.2398-1.0.322-1.0.4420.exe


»bp
0
 
HackooAuthor Commented:
I updated the vbscript in order to download from a direct or dynamic link with a progress bar in HTA.
Adwcleaner.pngAdwCleaner2.pngMBAM3.pnganim.gifMulti-downloader.vbs
Option Explicit
If AppPrevInstance() Then 
	MsgBox "The script is already launching" & vbCrlf &_
	CommandLineLike(WScript.ScriptName),VbExclamation,"The script is already launching"    
	WScript.Quit  
Else	
	Const Copyright = " by Hackoo 2018"
	Dim Title : Title = "Get Header Location and download file" & Copyright
	Const WHR_EnableRedirects = 6
	Dim Default_Link,Base_Link,Dynamic_Link,Flag,Question,DirectLink,Save2File
	Dim fso,ws,Temp,WaitingMsg,oExec
	Default_Link = "https://download.toolslib.net/download/file/1/1388"
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("WScript.Shell")
	Temp = ws.ExpandEnvironmentStrings("%Temp%")
' "https://downloads.malwarebytes.com/file/mb3/" 'Tested OK ==> Malwarebytes v3.4.4
' "https://download.toolslib.net/download/file/1/1388" 'Tested OK ==> Adwcleaner v7.0.8.0
' "https://www.google.tn/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png" Tested OK ==> a direct link example
	Base_Link = InputBox("Copy and paste your link here to get the response header",Title,Default_Link)
	If CheckDirectLink(Base_Link) = True And Instr(Base_Link,"php") = 0 Then 'Check if it is a direct link
		Save2File = GetFileNamefromDirectLink(Base_Link)
		If Save2File = "" Then
			MsgBox "An unknown error has occurred ! Quitting the script !",vbCritical,Title
			Wscript.Quit()
		End If
		WaitingMsg = "Please wait ... The download of : <font color=Yellow>"& DblQuote(Save2File) & "</font> is in progress ..."
		Call CreateProgressBar(Title,WaitingMsg)'Creation of Waiting Bar
		Call LaunchProgressBar() 'Launch of the Waiting Bar
		Call Download(Base_Link,Save2File)
		pause(3)
		Call CloseProgressBar()
		MsgBox "The download of the file : "& Save2File & vbCrlf &_
		"is Completed !",vbInformation,Title
		wscript.Quit()
	End If
	Call GetHeaderLocation(Base_Link)
	If Flag = True And CheckDirectLink(GetHeaderLocation(Base_Link)) = True Then 'Checking for a direct link of Malwarebytes 
		Save2File = GetFileNamefromDirectLink(GetHeaderLocation(Base_Link))
		If Save2File = "" Then
			MsgBox "An unknown error has occurred ! Quitting the script !",vbCritical,Title
			Wscript.Quit()
		End If
		DirectLink = GetHeaderLocation(Base_Link)
'wscript.echo DirectLink & vbCrlf & Save2File
		Question = MsgBox("Did you want to download this file ?" & vbCrlf &_
		Save2File,vbQuestion+vbYesNo,Title)
		If Question = vbYes Then
			If Save2File <> "" Then
				WaitingMsg = "Please wait ... The download of : <font color=Yellow>"& DblQuote(Save2File) & "</font> is in progress ..."
				Call CreateProgressBar(Title,WaitingMsg)'Creation of Waiting Bar
				Call LaunchProgressBar() 'Launch of the Waiting Bar
				Call Download(DirectLink,Save2File)
				Call CloseProgressBar()
				MsgBox "The download of the file : "& Save2File & vbCrlf &_
				"is Completed !",vbInformation,Title
				Wscript.Quit()
			End If	
		End If
	ElseIf Instr(Base_Link,"toolslib") <> 0 And Flag = True Then 'for Adwcleaner
		Dynamic_Link = Extract_Dynamic_Link(GetDataFromURL(Base_Link,"Get", ""))
		Save2File = GetFileName(GetHeaderLocation(Dynamic_Link))
		If Save2File = "" Then
			MsgBox "An unknown error has occurred ! Quitting the script !",vbCritical,Title
			Wscript.Quit()
		End If
		Question = MsgBox("The Dynamic Link is = "& Dynamic_Link & vbcrlf & vbcrlf &_
		"Response of The Dynamic Link is : "& vbcrlf & GetHeaderLocation(Dynamic_Link) & vbCrlf & vbCrlf &_
		"Extracted FileName is = " & Save2File,vbYesNo+vbQuestion,Title)
		If Question = vbYes Then
			WaitingMsg = "Please wait ... The download of : <font color=Yellow>"& DblQuote(Save2File) & "</font> is in progress ..."
			Call CreateProgressBar(Title,WaitingMsg)'Creation of Waiting Bar
			Call LaunchProgressBar() 'Launch of the Waiting Bar
			Call Download(Dynamic_Link,Save2File)
			Call CloseProgressBar()
			MsgBox "The download of the file : "& Save2File & vbCrlf &_
			"is Completed !",vbInformation,Title
		Else
			Wscript.Quit()
		End If		
	ElseIf Instr(Base_Link,"php") > 0 And Flag = False Then
		Save2File = GetFileName(GetHeaderLocation(Base_Link)) ' for site of autoitscript.fr
		If Save2File = "" Then 
			MsgBox "An unknown error has occurred ! Quitting the script !",vbCritical,Title
			Wscript.Quit()
		End If
		Question = MsgBox("Did you want to download this file ?" & vbCrlf &_
		Save2File,vbQuestion+vbYesNo,Title)
		If Question = vbYes Then
			WaitingMsg = "Please wait ... The download of : <font color=Yellow>"& DblQuote(Save2File) & "</font> is in progress ..."
			Call CreateProgressBar(Title,WaitingMsg)'Creation of Waiting Bar
			Call LaunchProgressBar() 'Launch of the Waiting Bar
			Call Download(Base_Link,Save2File)
			pause(3)
			Call CloseProgressBar()
			MsgBox "The download of the file : "& Save2File & vbCrlf &_
			"is Completed !",vbInformation,Title
		Else
			Wscript.Quit()
		End If
	End If
End If
'------------------------------------------------
Function GetHeaderLocation(URL)
	On Error Resume Next
	Dim h,GetLocation
	Set h = CreateObject("WinHttp.WinHttpRequest.5.1")
	h.Option(WHR_EnableRedirects) = False
	h.Open "HEAD", URL , False
	h.Send()
	GetLocation = h.GetResponseHeader("Location")
	If Err = 0 Then
		Flag = True
		GetHeaderLocation = GetLocation
	Else
		Flag = False
		GetHeaderLocation = h.GetResponseHeader("Content-Disposition")
	End If	
End Function
'---------------------------------------------
Function GetFileName(Data)
	Dim regEx, Match, Matches,FileName
	Set regEx = New RegExp
	regEx.Pattern = "\x27{2}(\w.*)"
	regEx.IgnoreCase = True
	regEx.Global = True
	If regEx.Test(Data) Then
		Set Matches = regEx.Execute(Data)
		For Each Match in Matches
			FileName = Match.subMatches(0)
		Next
	Else
		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
	End If
	GetFileName = FileName
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 GetFileNamefromDirectLink(URL)
	Dim ArrFile,FileName
	ArrFile = Split(URL,"/")
	FileName = ArrFile(UBound(ArrFile))
	GetFileNamefromDirectLink = FileName
End Function
'------------------------------------------------
Function CheckDirectLink(URL)
	Dim regEx
	Set regEx = New RegExp
	regEx.Pattern = "(.exe|.zip|.rar|.msi|.vbs|.bat|.hta|.txt|.log|.doc" & _
	"|.docx|.xls|.xlsx|.pdf|.mp3|.mp4|.avi|.png|.jpg|.jpeg|.bmp|.gif)"
	regEx.IgnoreCase = True
	regEx.Global = False
	If regEx.Test(URL) Then
		CheckDirectLink = True
	End If
End Function
'------------------------------------------------
'**********************************************************************************************
Sub CreateProgressBar(Title,WaitingMsg)
	Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
	Set ws = CreateObject("wscript.Shell")
	Set fso = CreateObject("Scripting.FileSystemObject")
	Temp = WS.ExpandEnvironmentStrings("%Temp%")
	PathOutPutHTML = Temp & "\Barre.hta"
	Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
	fhta.WriteLine "<HTML>"
	fhta.WriteLine "<HEAD>"
	fhta.WriteLine "<Title>  " & Title & "</Title>"
	fhta.WriteLine "<HTA:APPLICATION"
	fhta.WriteLine "ICON = ""magnify.exe"" "
	fhta.WriteLine "BORDER=""THIN"" "
	fhta.WriteLine "INNERBORDER=""NO"" "
	fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
	fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
	fhta.WriteLine "SCROLL=""NO"" "
	fhta.WriteLine "SYSMENU=""NO"" "
	fhta.WriteLine "SELECTION=""NO"" "
	fhta.WriteLine "SINGLEINSTANCE=""YES"">"
	fhta.WriteLine "</HEAD>"
	fhta.WriteLine "<BODY text=""white""><CENTER>"
	fhta.WriteLine "<marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & WaitingMsg &"</font></marquee>"
	fhta.WriteLine "<img src=""data:image/gif;base64,R0lGODlhgAAPAPIAAP////INPvvI0/q1xPVLb/INPgAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh/hpDcmVhdGVkIHdpdGggYWpheGxvYWQuaW5mbwAh+QQJCgAAACwAAAAAgAAPAAAD5wiyC/6sPRfFpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwDkJEDE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/4ixgeloM5erDHonOWBFFlJoxiiTFtqWwa/Jhx/86nKdc7vuJ6mxaABbUaUTvljBo++pxO5nFQFxMY1aW12pV+q9yYGk6NlW5bAPQuh7yl6Hg/TLeu2fssf7/19Zn9meYFpd3J1bnCMiY0RhYCSgoaIdoqDhxoFnJ0FFAOhogOgo6GlpqijqqKspw+mrw6xpLCxrrWzsZ6duL62qcCrwq3EsgC0v7rBy8PNorycysi3xrnUzNjO2sXPx8nW07TRn+Hm3tfg6OLV6+fc37vR7Nnq8Ont9/Tb9v3yvPu66Xvnr16+gvwO3gKIIdszDw65Qdz2sCFFiRYFVmQFIAEBACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9J2qd1AoM9MYeF4KaWJKWmaJXxEyulI3zWa/39Xh6/vkT3q/DC/JiBFjMSCM2hUybUwrdFa3Pqw+pdEVxU3AViKVqwz30cKzmQpZl8ZlNn9uzeLPH7eCrv2l1eXKDgXd6Gn5+goiEjYaFa4eOFopwZJh/cZCPkpGAnhoFo6QFE6WkEwOrrAOqrauvsLKttKy2sQ+wuQ67rrq7uAOoo6fEwsjAs8q1zLfOvAC+yb3B0MPHD8Sm19TS1tXL4c3jz+XR093X28ao3unnv/Hv4N/i9uT45vqr7NrZ89QFHMhPXkF69+AV9OeA4UGBDwkqnFiPYsJg7jBktMXhD165jvk+YvCoD+Q+kRwTAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJdCLnC/S+nsCFo1dq5zeRoFlJ1Du91hOq3b3qNo/5OdZPGDT1QrSZDLIcGp2o47MYheJuImmVer0lmRVlWNslYndm4Jmctba5gm9sPI+gp2v3fZuH78t4Xk0Kg3J+bH9vfYtqjWlIhZF0h3qIlpWYlJpYhp2DjI+BoXyOoqYaBamqBROrqq2urA8DtLUDE7a1uLm3s7y7ucC2wrq+wca2sbIOyrCuxLTQvQ680wDV0tnIxdS/27TND+HMsdrdx+fD39bY6+bX3um14wD09O3y0e77+ezx8OgAqutnr5w4g/3e4RPIjaG+hPwc+stV8NlBixAzSlT4bxqhx46/MF5MxUGkPA4BT15IyRDlwG0uG55MAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPECwbnu3gUKH1h2ZziNKVlJWDW9FvSuI/nkusPjrF0OaBIGfTna7GaTNTPGIvK4GUZRV1WV+ssKlE/G0hmDTqVbdPeMZWvX6XacAy6LwzAF092b9+GAVnxEcjx1emSIZop3g16Eb4J+kH+ShnuMeYeHgVyWn56hakmYm6WYnaOihaCqrh0FsbIFE7Oytba0D7m6DgO/wAMTwcDDxMIPx8i+x8bEzsHQwLy4ttWz17fJzdvP3dHfxeG/0uTjywDK1Lu52bHuvenczN704Pbi+Ob66MrlA+scBAQwcKC/c/8SIlzI71/BduysRcTGUF49i/cw5tO4jytjv3keH0oUCJHkSI8KG1Y8qLIlypMm312ASZCiNA0X8eHMqPNCTo07iyUAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8hffaB3ZiWJKfmaJgJWHV5FqQK9uPuDr6yPeTniAIzBV/utktVmPCOE8GUTc9Ia0AYXWXPXaTuOhr4yRDzVIjVY3VsrnuK7ynbJ7rYlp+6/u2vXF+c2tyHnhoY4eKYYJ9gY+AkYSNAotllneMkJObf5ySIphpe3ajiHqUfENvjqCDniIFsrMFE7Sztre1D7q7Dr0TA8LDA8HEwsbHycTLw83ID8fCwLy6ubfXtNm40dLPxd3K4czjzuXQDtID1L/W1djv2vHc6d7n4PXi+eT75v3oANSxAzCwoLt28P7hC2hP4beH974ZTEjwYEWKA9VBdBixLSNHhRPlIRR5kWTGhgz1peS30l9LgBojUhzpa56GmSVr9tOgcueFni15styZAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKsWIPiFwhia4kWWKrl5UGXFMFa/nJ0Da+r0rF9vAiQOH0DZTMeYKJ0y6O2JPApXRmxVe3VtSVSmRLzENWm7MM+65ra93dNXHgep71H0mSzdFec+b3SCgX91AnhTeXx6Y2aOhoRBkllwlICIi49liWmaapGhbKJuSZ+niqmeN6SWrYOvIAWztAUTtbS3uLYPu7wOvrq4EwPFxgPEx8XJyszHzsbQxcG9u8K117nVw9vYD8rL3+DSyOLN5s/oxtTA1t3a7dzx3vPwAODlDvjk/Orh+uDYARBI0F29WdkQ+st3b9zCfgDPRTxWUN5AgxctVqTXUDNix3QToz0cGXIaxo32UCo8+OujyJIM95F0+Y8mMov1NODMuPKdTo4hNXgMemGoS6HPEgAAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9pcgitpIhmaZouMGYq/LwbPMTJVE34/Z9j7BJCgE+obBnAWSwzWZMaUz+nQQkUfjyhrEmqTQGnins5XH5iU3u94Crtpfe4SuV9NT8R0Nn5/8RYBedHuFVId6iDyCcX9vXY2Bjz52imeGiZmLk259nHKfjkSVmpeWanhhm56skIyABbGyBROzsrW2tA+5ug68uLbAsxMDxcYDxMfFycrMx87Gv7u5wrfTwdfD2da+1A/Ky9/g0OEO4MjiytLd2Oza7twA6/Le8LHk6Obj6c/8xvjzAtaj147gO4Px5p3Dx9BfOQDnBBaUeJBiwoELHeaDuE8uXzONFu9tE2mvF0KSJ00q7Mjxo8d+L/9pRKihILyaB29esEnzgkt/Gn7GDPosAQAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTcJJKmV5oUKJ7qBGPyKMzNVUkzjFoSPK9YjKHQQgSve7eeTKZs7ps4GpRqDSNcQu01Kazlwbxp+ksfipezY1V5X2ZI5XS1/5/j7l/12A/h/QXlOeoSGUYdWgXBtJXEpfXKFiJSKg5V2a1yRkIt+RJeWk6KJmZhogKmbniUFrq8FE7CvsrOxD7a3Drm1s72wv7QPA8TFAxPGxcjJx8PMvLi2wa7TugDQu9LRvtvAzsnL4N/G4cbY19rZ3Ore7MLu1N3v6OsAzM0O9+XK48Xn/+notRM4D2C9c/r6Edu3UOEAgwMhFgwoMR48awnzMWOIzyfeM4ogD4aMOHJivYwexWlUmZJcPXcaXhKMORDmBZkyWa5suE8DuAQAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9h03gZNgmtqJXqqwka8YM2NlQXYN2ze254/WyiF0BYU8nSyJ+zmXQB8UViwJrS2mlNacerlbSbg3E5fJ1WMLq9KeleB3N+6uR+XEq1rFPtmfdHd/X2aDcWl5a3t+go2AhY6EZIZmiACWRZSTkYGPm55wlXqJfIsmBaipBROqqaytqw+wsQ6zr623qrmusrATA8DBA7/CwMTFtr24yrrMvLW+zqi709K0AMkOxcYP28Pd29nY0dDL5c3nz+Pm6+jt6uLex8LzweL35O/V6fv61/js4m2rx01buHwA3SWEh7BhwHzywBUjOGBhP4v/HCrUyJAbXUSDEyXSY5dOA8l3Jt2VvHCypUoAIetpmJgAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8q/YdN4Gj+AgoqqVqJWHkFrsW5Jbzbee8yaaTH4qGMxF3Rh0s2WMUnUioQygICo9LqYzJ1WK3XiX4Na5Nhdbfdy1mN8nuLlxMTbPi4be5/Jzr+3tfdSdXbYZ/UX5ygYeLdkCEao15jomMiFmKlFqDZz8FoKEFE6KhpKWjD6ipDqunpa+isaaqqLOgEwO6uwO5vLqutbDCssS0rbbGuMqsAMHIw9DFDr+6vr/PzsnSx9rR3tPg3dnk2+LL1NXXvOXf7eHv4+bx6OfN1b0P+PTN/Lf98wK6ExgO37pd/pj9W6iwIbd6CdP9OmjtGzcNFsVhDHfxDELGjxw1Xpg4kheABAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTeBowiZjqCqG9malYS5sXXScYnvcP6swJqux2MMjTeiEjlbyl5MAHAlTEarzasv+8RCu9uvjTuWTgXedFhdBLfLbGf5jF7b30e3PA+/739ncVp4VnqDf2R8ioBTgoaPfYSJhZGIYhN0BZqbBROcm56fnQ+iow6loZ+pnKugpKKtmrGmAAO2twOor6q7rL2up7C/ssO0usG8yL7KwLW4tscA0dPCzMTWxtXS2tTJ297P0Nzj3t3L3+fmzerX6M3hueTp8uv07ezZ5fa08Piz/8UAYhPo7t6+CfDcafDGbOG5hhcYKoz4cGIrh80cPAOQAAAh+QQJCgAAACwAAAAAgAAPAAAD5wi0C/6sPRfJpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwFkJEFE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAA7AAAAAAAAAAAA"" />"
	fhta.WriteLine "</CENTER></BODY></HTML>"
	fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
	fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
	fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
	fhta.WriteLine "Sub window_onload()"
	fhta.WriteLine "    CenterWindow 570,100"
	fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
	fhta.WriteLine " End Sub"
	fhta.WriteLine " Sub CenterWindow(x,y)"
	fhta.WriteLine "    Dim iLeft,itop"
	fhta.WriteLine "    window.resizeTo x,y"
	fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
	fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
	fhta.WriteLine "    window.moveTo ileft,itop"
	fhta.WriteLine "End Sub"
	fhta.WriteLine "</script>"
	fhta.close
End Sub
'**********************************************************************************************
Sub LaunchProgressBar()
	Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub CloseProgressBar()
	oExec.Terminate
End Sub
'**********************************************************************************************
Function DblQuote(Str)
	DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Pause(Secs)    
	Wscript.Sleep(Secs * 1000)    
End Sub   
'**********************************************************************************************
Function AppPrevInstance()
	With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")  
		With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
			" AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")
			AppPrevInstance = (.Count > 1)
		End With
	End With
End Function    
'*********************************************************************************************
Function CommandLineLike(ProcessPath)
	ProcessPath = Replace(ProcessPath, "\", "\\")
	CommandLineLike = "'%" & ProcessPath & "%'" 
End Function
'*********************************************************************************************

Open in new window

Multi-Downloader.vbs
0
 
HackooAuthor Commented:
Because i solved my problem by my self assisted with a member "Jay" in another site : http://batch.xoo.it/t5999-Comment-obtenir-le-lien-direct-depuis-url-par-vbscript.htm#p44945
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now