Mäta överföringshastighet med Inet

Jag försöker mäta hastigheten när jag hämtar ett dokument via Inet. Problemet är att den först verkar mäta när ALL data har hämtats. Allting ser finfint ut hemma på bredbandsbolaget men då händer ju allt på en gång. =) Testade jag på ett modem så fylldes min progressbar först till 100% då den "var klar".

Variabeln STATEN sätts till true när state på INET = "response received". Obs! Filstorleken skriver jag i headern på servern o lagras i s. Här är mitt exempel;

Function getData(ByVal link As String, ByVal param As String) As String
STATEN = False
' exekverar och hämtar upp data
Dim vtdata As String
Dim strdata As String
Dim bdone As Boolean
Dim started As Date
Dim header() As String
Dim size() As String
Dim s As Long
Dim strLength As Long
Dim proc As Integer
Dim speedStart As Date
Dim speedTime As Date
Dim intSpeed As Double
Dim seconds As Double

Dim timp As Integer
Dim tmp() As String

With frmSys.Inet
    .RequestTimeout = WEBTIMEOUT
    .AccessType = 0
    .Execute link, "POST", param
    started = Now
    On Error GoTo 0: On Error Resume Next
    Do
        DoEvents
        If CInt(DateDiff("s", started, Now)) \> CInt(WEBTIMEOUT) Or Err.Number \<\> 0 Then
            Call timeout
        End If
        Sleep (1)
    Loop While STATEN = False
    On Error GoTo 0
    header = Split(.GetHeader, Chr(13))
    size = Split(header(3), ":")
    s = CLng(size(1))
    bdone = False
    strdata = ""
         
    speedStart = Now
    Do While Not s = strLength

        vtdata = .GetChunk(2048, icString)
        strdata = strdata & vtdata
        strLength = Len(strdata)
        proc = strLength / s \* 100
        frmMain.lblProc = proc & " %"
        frmMain.proBar = proc
        frmMain.Label1.Caption = strLength & "/" & s
        ' speed
        seconds = CInt(DateDiff("s", speedStart, Now))
        If seconds \> 0 Then
            intSpeed = CInt((strLength / 1024) / seconds)
            frmMain.lblSpeed = intSpeed & " kb/s"
        End If
        If Len(vtdata) = 0 Then
           bdone = True
           frmMain.StatusBar1.Panels(1).Text = "Status: Ledig"
        End If
        DoEvents
        Sleep (1)
    Loop
    .Cancel
End With


getData = strdata

End Function