Option Explicit Event DownloadCompleted(ByRef completedURL As String, ByRef filename As String, ByVal downloadTime As Long) Event DownloadFailed(ByRef failedURL As String, ByRef filename As String, ByVal bytesDownloaded As Long) Event DownloadingAlready(ByRef existingURL As String, ByRef newURL As String) Event DownloadCanceled(ByRef canceledURL As String) Private rounding As Byte Private divisor As Single Private unit As String Private WithEvents netCon As Inet Private pBar As MSComctlLib.ProgressBar Private statusDisplay As Object Private fileHandle As Integer Private saveFilename As String Private savePath As String Private tempStr As String Private tempInt As Integer Private isDownloading As Boolean Private cancelRequested As Boolean Private hasStatusDisplay As Boolean Private hasProgressBar As Boolean Private chunkSize As Long Private chunksUp As Integer Private chunksDn As Integer Private Const INTERVAL_COUNT = 10 'number of intervals to record values at 'essentially equivalent to the number of 'seconds that the average speed is calculated from Private bytesTotal As Long 'file size Private bytesSoFar As Long 'bytes downloaded in total Private bytesThisInterval As Long 'bytes downloaded in the last ~second Private bytesLastInterval As Long 'bytes total up to about a second ago Private bytesTenSInterval As Long 'bytes downloaded in the last ~10 second Private bytesAtInterval(0 To (INTERVAL_COUNT - 1)) As Long 'bytes total at a particular interval Private intervalPointerThis As Integer 'remembers which interval we are on Private intervalPointerLast As Integer 'stores the last interval we were on Private intervalPointerNext As Integer 'stores the next interval Private averageSpeed As Long 'average speed in bytes/sec Private instantSpeed As Long 'speed over the last ~second Private percentDone As Integer 'percentage complete Private startTimeStamp As Single 'time when the transfer began Private timeAtInterval(0 To (INTERVAL_COUNT - 1)) As Single 'time of the last progress observation Private timeThisInterval As Single 'seconds since the last clock tick Private timeTenSInterval As Single 'seconds between now and about 10 seconds ago Private timeTotal As Single 'how many seconds weve been downloading Private remainTime As Long 'how many seconds we have left to go 'public 'public 'public Public Function getPercentDone() As Integer getPercentDone = Round((bytesSoFar / bytesTotal) * 100) End Function Public Function getTimeElapsed() As Long getTimeElapsed = timeTotal End Function Public Function getTimeRemaining() As Long calculateTotals False getTimeRemaining = remainTime End Function Public Function getBytesDownloaded() As Long getBytesDownloaded = bytesSoFar End Function Public Function getBytesRemaining() As Long getBytesRemaining = bytesTotal - bytesSoFar End Function Public Function getFilesize() As Long getFilesize = bytesTotal End Function Public Function getAverageSpeed() As Long calculateTotals False getAverageSpeed = averageSpeed End Function Public Function getInstantSpeed() As Long calculateTotals False getInstantSpeed = instantSpeed End Function Public Sub retry() If isDownloading Then cancelDownload End If 'reset cancellation order for next time cancelRequested = False Dim turl As String turl = netCon.url Set netCon = Nothing 'send a get request downloadURLTo turl, savePath End Sub Public Sub cancelDownload() cancelRequested = True netCon.Cancel isDownloading = False pBar.Value = 0 End Sub Public Sub downloadURLTo(strURL As String, saveDir As String) If isDownloading Then RaiseEvent DownloadingAlready(netCon.url, strURL) Exit Sub End If If Right$(saveDir, 1) <> "\" Then savePath = saveDir & "\" Else savePath = saveDir End If resetCounters startTimeStamp = DateTime.Timer 'set the correct protocol If netCon Is Nothing Then Set netCon = New Inet netCon.Protocol = icHTTP End If 'reset cancellation order for next time cancelRequested = False 'send a get request netCon.Execute strURL, "GET" isDownloading = True End Sub Public Sub showStatusInTextBox(ByRef tb As VB.TextBox) Set statusDisplay = Nothing Set statusDisplay = tb hasStatusDisplay = True End Sub Public Sub showStatusInStatusBarPanel(ByRef sbp As MSComctlLib.Panel) Set statusDisplay = Nothing Set statusDisplay = sbp hasStatusDisplay = True End Sub Public Sub showProgressWithProgressBar(ByRef pb As MSComctlLib.ProgressBar) Set pBar = Nothing Set pBar = pb hasProgressBar = True End Sub Public Sub doNotReportStatus() Set statusDisplay = Nothing hasStatusDisplay = False End Sub Public Sub doNotUseProgressBar() Set pBar = Nothing hasProgressBar = False End Sub Public Sub statusInMegaBytes() rounding = 2 divisor = 1024 * 1024 unit = "MB" End Sub Public Sub statusInKiloBytes() rounding = 0 divisor = 1024 unit = "KB" End Sub Public Sub statusInBytes() rounding = 0 divisor = 1 unit = "B" End Sub Public Sub statusInMegaBits() rounding = 2 divisor = 1024 * 1024 / 8 unit = "Mbit" End Sub Public Sub statusInKiloBits() rounding = 1 divisor = 1024 / 8 unit = "Kbit" End Sub Public Sub statusInBits() rounding = 0 divisor = 1 / 8 unit = "bit" End Sub 'private 'private 'private Private Sub resetCounters() 'clear things - i clear with 1, and not 0, to avoid initial div/0 errors bytesTotal = 1 bytesSoFar = 1 bytesLastInterval = 1 bytesThisInterval = 1 bytesTenSInterval = 1 Dim i As Integer For i = 0 To (INTERVAL_COUNT - 1) bytesAtInterval(i) = 1 timeAtInterval(i) = startTimeStamp Next 'by setting -1, last will become 0 upon the first tick, and we start to 'fill our array intervalPointerLast = -1 intervalPointerThis = -1 intervalPointerNext = -1 averageSpeed = 1 instantSpeed = 1 timeThisInterval = 1 timeTotal = 1 remainTime = 1 End Sub Private Sub stat(ByRef strData As String) If hasStatusDisplay Then statusDisplay.Text = strData End If End Sub Private Sub calculateTotals(chunkAdjustment As Boolean) 'increment and mod is the standard way to make a circular 'array pointer.. upon reaching INTERVAL_COUNT, intervalPointer 'is reset to 0. 'move the pointers on one intervalPointerLast = (intervalPointerLast + 1) Mod INTERVAL_COUNT intervalPointerThis = (intervalPointerLast + 1) Mod INTERVAL_COUNT intervalPointerNext = (intervalPointerThis + 1) Mod INTERVAL_COUNT 'store how many bytes we've got to, at the current time bytesAtInterval(intervalPointerThis) = bytesSoFar timeAtInterval(intervalPointerThis) = DateTime.Timer 'set the times timeTotal = timeAtInterval(intervalPointerThis) - startTimeStamp timeThisInterval = timeAtInterval(intervalPointerThis) - timeAtInterval(intervalPointerLast) timeTenSInterval = timeAtInterval(intervalPointerThis) - timeAtInterval(intervalPointerNext) 'adjust the chunking if necessary. The theory here is to keep the 'chunksBeforeCalcOccurs floating around a certain value such that a 'calculation happens every second. we also want to exit the routine 'if it is less than 1, as we may hit a div/0 'reset the chunks counter If chunkAdjustment Then If timeThisInterval < 1 Then chunkSize = chunkSize + 256 chunksUp = chunksUp + 1 ElseIf chunkSize > 256 Then chunkSize = chunkSize - 256 chunksDn = chunksDn + 1 End If End If 'calculate how many bytes transferred in the last second bytesThisInterval = bytesSoFar - bytesAtInterval(intervalPointerLast) 'calculate how many bytes transferred since the least recently used array index (the next one) bytesTenSInterval = bytesSoFar - bytesAtInterval(intervalPointerNext) 'the average speed over the array interval. we add one to avoid div/0 errors 'laters, and 1byte/second isnt going to be noticed averageSpeed = (bytesTenSInterval / timeTenSInterval) + 1 'speed over the last ~1 second instantSpeed = (bytesThisInterval / (timeThisInterval + 0.0001)) 'set the remain time as a function of the average speed remainTime = (bytesTotal - bytesSoFar) / averageSpeed End Sub Private Sub netCon_StateChanged(ByVal State As Integer) DoEvents Select Case State Case icNone: stat "Nothing to report" Case icResolvingHost: stat "Resolving Host" Case icHostResolved: stat "Host Resolved" Case icConnecting: stat "Connecting..." Case icConnected: stat "Connected" Case icRequesting stat "Requesting " & netCon.Document isDownloading = True Case icResponseReceived 'try to get the "Content-Length" field. This 'tells us how long the file is in bytes 'it isnt always available - but thats okay, cos 'if it isnt, we will check again when we get a chunk checkContentLength Case icDisconnecting stat "Disconnecting..." Case icDisconnected 'if the user canceled or the downlaod failed.. raise complete happens elsewhere isDownloading = False If cancelRequested Then stat "Download canceled" RaiseEvent DownloadCanceled(netCon.url) ElseIf bytesSoFar < bytesTotal Then stat "Download failed at " & getPercentDone & "%" RaiseEvent DownloadFailed(netCon.url, savePath & saveFilename, bytesSoFar) End If Case icError stat "Error occurred - " & netCon.ResponseCode & ": " & netCon.ResponseInfo cancelDownload 'note that with Execute, it does not wait to get 'the whole file - response completed fires when the headers have completed Case icResponseCompleted doDownload End Select End Sub Private Sub doDownload() On Error GoTo errHandler Dim bData() As Byte 'response completed = file is available stat "HTTP 200 OK - The server will send the file" checkContentLength 'open our local file for saving to - save it in temp, as the file name fileHandle = FreeFile 'check if it's a valid name tempInt = Len(netCon.Document) - InStrRev(netCon.Document, "/") If tempInt < 1 Then 'no document name. invent one saveFilename = "Unknown File " & DateTime.Date$ & Rnd(DateTime.Timer) & ".unk" Else saveFilename = Right$(netCon.Document, tempInt) 'replace illegal chars Replace saveFilename, "?", "_" Replace saveFilename, "<", "_" Replace saveFilename, ">", "_" Replace saveFilename, "|", "_" Replace saveFilename, ":", "_" Replace saveFilename, "\", "_" Replace saveFilename, "/", "_" Replace saveFilename, "*", "_" Replace saveFilename, """", "_" End If Open (savePath & saveFilename) For Binary As #fileHandle stat "Saving to: " & (savePath & saveFilename) 'grab the first chunk of response data bData = netCon.GetChunk(chunkSize, icByteArray) DoEvents 'and save it to file If cancelRequested Then Close #fileHandle Exit Sub Else Put #fileHandle, , bData End If 'continue until the buffer is empty Do While UBound(bData()) > 0 'chunk and save bData = netCon.GetChunk(chunkSize, icByteArray) DoEvents 'write our file? maybe the user clicked cancel If cancelRequested Then Close #fileHandle Exit Sub Else Put #fileHandle, , bData bytesSoFar = bytesSoFar + UBound(bData()) End If 'update the download total. pass true to update the chunk size calculateTotals True 'set the progress bar only if it is valid to do so If bytesTotal > bytesSoFar Then 'do we update the progressbar? If hasProgressBar Then pBar.Value = getPercentDone() End If 'do we report our status? we will if this aswell, to avoid doing mass 'unnecessary calcs.. another if will take place in the stat method, but oh well.. If hasStatusDisplay Then stat (getPercentDone() & "% done - " & _ Round((bytesSoFar / divisor), rounding) & " of " & _ Round((bytesTotal / divisor), rounding) & unit & "s, " & _ Round((averageSpeed / divisor), rounding) & unit & "/s (" & _ Round((instantSpeed / divisor), rounding) & unit & "/s) - approx " & _ (remainTime \ 60) & ":" & Right$("0" & (remainTime Mod 60), 2) & "s left") End If Else 'do we report our status? stat "File size undetermined at this time." 'try and get the content size - should never occur as we should get 'it before a chunk occurs checkContentLength End If Loop 'close the file Close #fileHandle 'reset things isDownloading = False pBar.Value = 0 timeTotal = DateTime.Timer - startTimeStamp If hasStatusDisplay Then stat "Download complete: " & _ Round((bytesTotal / divisor), rounding) & unit & "s took " & _ Round(timeTotal, rounding) & " seconds (" & _ Round((bytesTotal / divisor) / timeTotal, rounding) & unit & "s/second)" End If RaiseEvent DownloadCompleted(netCon.url, savePath & saveFilename, timeTotal) Exit Sub errHandler: If Err.Number = 35761 Then RaiseEvent DownloadFailed(netCon.url, savePath & saveFilename, bytesSoFar) End If End Sub Private Sub checkContentLength() On Error Resume Next Dim cl As String cl = netCon.GetHeader("Content-Length") If Len(cl) = 0 Or cl = "" Then bytesTotal = -1 Else bytesTotal = CLng(cl) End If Exit Sub End Sub Private Sub Class_Initialize() divisor = 1 unit = "B" chunkSize = 2048 End Sub