All pastes #954228 Raw Edit

Someone

public text v1 · immutable
#954228 ·published 2008-03-23 19:36 UTC
rendered paste body

'// 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