'// Handle data arriving on w Private Sub w_DataArrival(ByVal bytesTotal As Long) Dim dat() As Byte Dim crspl, i, lenspl, dblcrspl, flen, cmpname, cmpext, cmpspl, pcnt '// If reqsize is true, then parse the HTTP response for the Content-Length value If reqsize = True Then w.GetData dat, vbByte Or vbArray, 1024 '// HTTP 404 recieved from the server; abort. If LCase(Mid(dat, 1, 12)) = "http/1.1 404" Then logg "Recieved HTTP not found. Aborting." MsgBox "404: Not found", vbExclamation, "" w.CloseSck Command2.Caption = "Download" Exit Sub End If crspl = Split(dat & vbCrLf & "[EOF]", vbCrLf) i = 0 While crspl(i) <> "[EOF]" If LCase(Mid(crspl(i) & "XXXXXXXXXXXXXXX", 1, 15)) = "content-length:" Then lenspl = Split(crspl(i) & ": 0", ": ") fsize = lenspl(1) logg "File size is: " & (fsize / 1024) & " Kb" reqsize = False End If i = i + 1 Wend '// Failed to parse Content-Length value. Invalid data. Abort. If reqsize = True Then MsgBox "Recieved unsupported or non-HTTP data from the server. Aborting.", vbExclamation, "" w.CloseSck Command2.Caption = "Download" Exit Sub End If w.CloseSck logg "Reconnecting to server..." w.Connect rhost, rport Exit Sub Else '// Otherwise, if reqsize is not true, then append the incomming data to the currently downloading file. w.GetData dat End If '// Remove the HTTP header If LCase(Mid(dat, 1, 12)) = "http/1.1 206" Then dblcrspl = Split(dat, vbCrLf & vbCrLf, 2) dat = dblcrspl(1) End If '// Append the currently downloading file Open downloadpath & "\" & fname & ".downloading" For Binary Access Write As #1 Put #1, LOF(1) + 1, dat 'Mid(dat, 1, Len(dat) - 2) Close #1 '// Check the file size against the servers file size to determine wether it has completed downloading flen = FileLen(downloadpath & "\" & fname & ".downloading") If Val(flen) = Val(fsize) Then '// Download has completed. Notify user, rename .downloading file, etc Form1.Caption = title ' pb.Value = 0 Command2.Caption = "Download" logg "Download completed." '// If the .downloading file cannot be renamed because a file of that name already exists, '// then append a number to the file name. Eg. foobar(1).exe. (Increase the number until '// the file name is unique) fcmpname = downloadpath & "\" & fname If FileExists(fcmpname) Then cmpspl = Split(fname & ".", ".") cmpname = cmpspl(0) cmpext = cmpspl(1) i = 1 fcmpname = downloadpath & "\" & cmpname & "(" & i & ")" & "." & cmpext While FileExists(fcmpname) i = i + 1 fcmpname = downloadpath & "\" & cmpname & "(" & i & ")" & "." & cmpext Wend End If '// Rename the .downloading file to the name determined above Name downloadpath & "\" & fname & ".downloading" As fcmpname '// Notify user upon completion MsgBox "Download completed.", vbInformation, "" w.CloseSck Exit Sub End If '// Calculate & display progress in % 'Form1.Caption = cnt pcnt = flen / fsize * 100 ' pb.Value = Math.Round(pcnt) Form1.Caption = title & " [downloading: " & Round(flen / fsize * 100, 2) & "%]" End Sub