HTTP/HTTPS/FTP Downloader.

When ScriptEZ.API based script file is running, an identification area is appended

to the system menu of the console windows as following:

'//////////////////////////////////////////////////////////////////////////////

' Author: SYO

' Copyright (c) 2012

' ScriptEZ.API based application which uses facilities from RAD API about:

' . File + Directory stuff

' . File reading from http/https or ftp sites

' . Thread pool

' . Echo() method usage which displays always messages into a console window

' instead of WScript.Echo() with 2 behaviours for cscript.exe or wscript.exe

' . ScriptEZ.API Remoting Control Interface usage by NPTelnet.exe program

' (Connect to ScriptEZ.API process with <processid (PID)> as connection name)

'

' Purpose: A simple way to download a file from a public Http Website

'//////////////////////////////////////////////////////////////////////////////

const SCRIPTEZ_API = "ScriptEZ.API" ' Component name

const VERSION = "Simple Http Downloader - version 1.8"

const VERSION_FTP = "Simple Ftp Downloader - version 1.8"

Dim ScriptEZMain

Dim fso

Dim localFilename

Dim ftpFileSize

Dim ftpFile

' start the script

'/////////////////

Main()

' Main Subroutine

'////////////////

Sub Main()

Dim url, RemoteFilename

Set objArgs = WScript.Arguments

If( objArgs.Count < 2 OR objArgs.Count > 3) Then

MsgBox "Oops !" + vbLF + vbLF + _

"Available command line syntaxes:" + vbLF + _

". HttpDownload <HttpWebsite_or_FtpSite/Filename> <LocalFullFilename> or" + vbLF + _

". HttpDownload <HttpWebsite_or_FtpSite> <FullFilename> <LocalFullFilename>" + vbLF + vbLF + _

"For example," + vbLF + "downloading " + _

Chr(34) + "http://mysite.com/backup.zip or ftp://mysite.com/backup.zip" + Chr(34)+ vbLF + _

"file must be entered like below:" + vbLF + vbLF + _

"(1) HttpDownload http://mysite.com/backup.zip c:\temp\backup.zip or" + vbLF + _

"(2) HttpDownload http://mysite.com /backup.zip c:\temp\backup.zip" + vbLF + _

"(3) HttpDownload ftp://mysite.com/backup.zip c:\temp\backup.zip" + vbLF + _

"(4) HttpDownload ftp://mysite.com /backup.zip c:\temp\backup.zip" + vbLF, _

vbInformation, _

VERSION_HTTP

Exit Sub

End If

Set WshShell = CreateObject("WScript.Shell")

Set fso = CreateObject("Scripting.FileSystemObject")

Dim Windir

Dim FullQualifiedEngineName

' if Win64, restart with WScript.exe/CScript.exe 32 bits

On Error Resume Next

Windir = WshShell.ExpandEnvironmentStrings("%WinDir%")

FullQualifiedEngineName = Windir+"\SysWOW64" + Mid(WScript.FullName,InStrRev(WScript.FullName,"\"),Len(WScript.FullName))

If fso.FolderExists(Windir+"\SysWOW64") And LCase(WScript.FullName) <> LCase(FullQualifiedEngineName) Then

If objArgs.Count = 2 Then

cmdOptions = objArgs(0) + " " + objArgs(1)

Else

cmdOptions = objArgs(0) + " " + objArgs(1) + objArgs(2)

End If

WshShell.Run FullQualifiedEngineName + " " + Chr(34) + CStr(WScript.ScriptFullName) + Chr(34) + " " + cmdOptions

Exit Sub

End If

Dim protocol_http

protocol_http = 1

' case 1: complete URL

If objArgs.Count = 2 Then

pos = InStr(objArgs(0),"//")

If pos = 7 or pos = 6 or pos = 5 Then

url = Mid(objArgs(0),pos+2,Len(objArgs(0))-pos)

pos2 = InStr(url,"/")

RemoteFilename = Mid(url,pos2,Len(objArgs(0))-(pos2-1))

If pos = 6 Then

url = "http://" + Mid(url,1,pos2-1) ' The Http is used

ElseIf pos = 7 Then

url = "https://" + Mid(url,1,pos2-1) ' The Https is used

Else

url = "ftp://" + Mid(url,1,pos2-1) ' The Ftp is used

protocol_http = 0

End If

Else

pos = InStr(objArgs(0),"/")

RemoteFilename = Mid(objArgs(0),pos,Len(objArgs(0))-(pos-1))

url = Mid(objArgs(0),1,pos-1)

End If

localFilename = objArgs(1)

Else

' case 2: separated website and remotefilename

url = objArgs(0)

RemoteFilename = objArgs(1)

localFilename = objArgs(2)

If InStr(url,"ftp://") = 1 Then protocol_http = 0 ' The Ftp is used

End If

Set WshShell = CreateObject("WScript.Shell")

If protocol_http = 0 Then

' force to use MTA (Multi Threaded Apartment)

WshShell.RegWrite "HKCR\CLSID\{01947673-ADB3-48F4-A162-CF06BB23CBCD}\InprocServer32\ThreadingModel", _

"Free", _

"REG_SZ"

End If

On Error Resume Next

' attempt to instantiate component object with callback interface

Set ScriptEZMain = WScript.CreateObject(SCRIPTEZ_API,"ScriptEZMain_")

If protocol_http = 0 Then

' restore to STA (Single Threaded Apartment)

WshShell.RegWrite "HKCR\CLSID\{01947673-ADB3-48F4-A162-CF06BB23CBCD}\InprocServer32\ThreadingModel",_

"Both", _

"REG_SZ"

End If

Set WshShell = Nothing

If Not IsObject(ScriptEZMain) Then

MsgBox "Please, download and register " + SCRIPTEZ_API + _

" component from http://sovann.googlepages.com and try again...",vbInformation,VERSION_HTTP

Exit Sub

End If

ScriptEZMain.ClearConsole

ScriptEZMain.SetCPUCoreAffinity "0"

' Register App for receiving AppEvent(s) with onAppEvent(EventID)

ScriptEZMain.AppRegister

If protocol_http = 1 Then

' http file reading....

httpFileHandle = ScriptEZMain.OpenHttpFile(url,RemoteFilename)

If httpFileHandle <= 0 Then

ScriptEZMain.AppUnregister

Set ScriptEZMain = Nothing

Exit Sub

End If

r = ScriptEZMain.HttpReadFile(httpFileHandle)

If r = 1 Then

If fso.FileExists(localFilename) Then

Set zFile = fso.GetFile(localFilename)

zFile.Delete

Set zFile = Nothing

End If

Dim hBinaryFile, Slash, r, ret, rawData, readBytes, readTotalBytes

Dim fileSize

fileSize = 0

If Len(localFilename) > 0 then

hBinaryFile = ScriptEZMain.OpenBinaryFile(localFilename)

If hBinaryFile > 0 Then

startTime = ScriptEZMain.GetTimeStampEx(1)

If ScriptEZMain.ProbeMemoryStatus(-2) >= 2298 Then

fileSize = ScriptEZMain.HttpReadFile(-httpFileHandle) ' get this file size in Bytes or KBytes

End If

rawData = ScriptEZMain.HttpGetReadBufferAsBinary(httpFileHandle)

readBytes = ScriptEZMain.HttpGetReadBytes(httpFileHandle)

readTotalBytes = readBytes

ScriptEZMain.Echo vbLF + VERSION_HTTP + vbLF+". Writing into: " + localFilename

Slash =""

If InStr(objArgs(1),"/") <> 1 Then Slash ="/" ' Cosmetic displaying !!

Dim TotalSize

TotalSize = 0

Do Until readBytes <= 0

If fileSize > 0 Then

ScriptEZMain.SetConsoleTitle CStr(FormatNumber(readTotalBytes/1024,0,0,-2)) + _

" / "+ CStr(FormatNumber(fileSize,0,0,-2)) + _

" (" + CStr(Fix((TotalSize/fileSize)*100)) + "%) KBytes read from " + _

objArgs(0)+ Slash + objArgs(1)

ElseIf fileSize < 0 Then

ScriptEZMain.SetConsoleTitle CStr(FormatNumber(readTotalBytes/1024,0,0,-2)) + _

" / "+ CStr(fileSize) + " Bytes read from " + objArgs(0)+ Slash + objArgs(1)

Else

ScriptEZMain.SetConsoleTitle CStr(FormatNumber(readTotalBytes/1024,0,0,-2)) + _

" KBytes read from " + objArgs(0)+ Slash + objArgs(1)

End If

ret = ScriptEZMain.WriteBinaryFile(hBinaryFile,rawData,readBytes)

r = ScriptEZMain.HttpReadFile(httpFileHandle)

rawData = ScriptEZMain.HttpGetReadBufferAsBinary(httpFileHandle)

readBytes = ScriptEZMain.HttpGetReadBytes(httpFileHandle)

If readBytes > 1024 Then TotalSize = TotalSize + (readBytes/1024)

If readBytes = 0 Then

endTime = ScriptEZMain.GetTimeStampEx(1)

ScriptEZMain.Echo ". Download succeeded (" + CStr(FormatNumber(readTotalBytes/1024,0,0,-2)) + " KBytes read)"

ScriptEZMain.Echo ". Taken time : " + ScriptEZMain.GetTimeDiff(endTime,startTime) + " (hh:mn:ss.mss)"

Else

readTotalBytes = readTotalBytes + readBytes

End If

Loop

Else

MsgBox "Creating local file " + localFilename + " failed !",vbExclamation,VERSION_HTTP

End If

End If

End If

ScriptEZMain.CloseBinaryFile hBinaryFile

ScriptEZMain.CloseHttpFile httpFileHandle

Else

hFtpConnection = ScriptEZMain.OpenFtpConnection(url,"","")

If hFtpConnection > 0 Then

ScriptEZMain.Echo vbLF + VERSION_FTP + vbLF+". Writing into: " + localFilename

hThreadPool = ScriptEZMain.CreateTaskQueueObject(1)

r = ScriptEZMain.AddTask(hThreadPool,5000)

' get remote file size from Ftp Server

ftpFileSize = ScriptEZMain.FtpDownloadFile(hFtpConnection,RemoteFilename,"")

If(ftpFileSize<0) Then

' file size is over 4 GBytes

hugeSize = ScriptEZMain.FtpFileSize(hFtpConnection,RemoteFilename)

ftpFileSize = CDbl(hugeSize)

ScriptEZMain.FreeBSTR hugeSize

End If

' call and block till end

r = ScriptEZMain.FtpDownloadFile(hFtpConnection,RemoteFilename,localFilename)

ScriptEZMain.CloseFtpConnection hFtpConnection

If r = 1 Then

ScriptEZMain.Echo vbLF + "ftp downloading succeeded..."

Else

ScriptEZMain.Echo vbLF + "ftp downloading failed..."

End If

End If

End If

' App unregister before ending

ScriptEZMain.AppUnregister

WScript.Sleep 500

Set ScriptEZMain = Nothing

End Sub

Function ScriptEZMain_onRun(timeout)

WScript.Sleep timeout

' check whether local file is already created

If Not fso.FileExists(localFilename) Then

ScriptEZMain_onRun = CLng(1)

Exit Function

End If

If Not IsObject(ftpFile) Then

' create object once

Set ftpFile = fso.GetFile(localFilename)

End If

fileSize = ftpFile.Size

If ftpFileSize > 0 Then

ScriptEZMain.SetConsoleTitle "FTP downloading in progress: " + _

CStr(FormatNumber(fileSize/1024,0,0,-2)) + "/" + _

CStr(FormatNumber(ftpFileSize/1024,0,0,-2)) + " KBytes (" + _

CStr(Fix((fileSize/ftpFileSize)*100)) + "%)"

End If

ScriptEZMain_onRun = CLng(1)

End Function