Option Explicit
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As Long
#If Win64 Then 'to calculate download time in milliseconds
Declare PtrSafe Function GetTickCount64 Lib "kernel32" () As LongLong
#Else
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#End If
#If Win64 Then 'for my Win10 64-bit, Office 2019 *** 64-bit *** PC
Dim ST As LongLong 'start time point as returned by GetTickCount64
Dim ET As LongLong 'end time point as returned by GetTickCount64
Dim TT As LongLong 'time taken (ET - ST) in milliseconds
Dim FSize As LongLong 'in bits, not bytes
Dim MultiplyBy As LongLong
Dim DivideBy As LongLong
#Else 'for my Win10 64-bit, Office 2019 *** 32-bit *** PC
Dim ST As Long 'start time point as returned by GetTickCount
Dim ET As Long 'end time point as returned by GetTickCount
Dim TT As Long 'time taken (ET - ST) in milliseconds
Dim FSize As Currency 'in bits, not bytes
Dim MultiplyBy As Currency
Dim DivideBy As Currency
#End If
Private Const ERROR_SUCCESS As Long = 0
Private Const BINDF_GETNEWESTVERSION As Long = &H10
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Public Function DownloadSingleFile(sSourceUrl As String, sLocalFile As String, Optional ByVal AlertIfError As Boolean = True) As Boolean
'Download the file. BINDF_GETNEWESTVERSION forces the API to download from the specified source.
'Passing 0& as dwReserved causes the locally-cached copy to be downloaded, if available.
'If the API returns ERROR_SUCCESS (0), DownloadSingleFile returns True.
Dim RV As Long
'RV = URLDownloadToFile(0&, sSourceUrl, sLocalFile, BINDF_GETNEWESTVERSION, 0&)
RV = URLDownloadToFile(0&, sSourceUrl, sLocalFile, 0&, 0&)
If RV <> 0 Then 'ERROR_SUCCESS Then
If AlertIfError Then
MsgBox "Download failed, errror " & RV
End If
Else
DownloadSingleFile = True
End If
End Function
Public Function DownloadSpeed(Optional ByVal SourceURL As String = "", _
Optional ByVal DeleteAfterTest As Boolean = True) As String 'return value = Mbps
'**********************************************************************************************************************************
'My router is an Orange Livebox 6, fibre broadband, theoretically 2 Gbps
'My LAN: Ethernet, my PC network adapter's Speed & Duplex = 1.0 Gbps Full Duplex, as shown in Device Manager, Advanced Tab
'Therefore, in my home this function should return a value <= 1 Gbps (<= 1000 Mbps)
'==================================================================================
'But on average it's returning 3200 Mbps! As demonstrated above, that's impossible,
'because it's more than my max. LAN speed (1 Gbps) and more than my router's max. speed (2 Gbps)
'
' WHAT'S WRONG IN MY CODE BELOW?
'
'**********************************************************************************************************************************
Dim FN As String 'save-file name
Dim Success As Boolean
Dim mbps As Double
If Len(SourceURL) = 0 Then
SourceURL = "http://www.wot.fr/RPTB/RefDocs/Le bon usage Grammaire francaise - Grevisse.pdf"
'The above file's size is exactly (81,484,673 bytes * 8 = 651,877,384 bits on my FTP server
FN = ThisWorkbook.Path & "\SpeedTest.pdf"
Else
FN = ThisWorkbook.Path & "\" & Mid(SourceURL, InStrRev(SourceURL, "/") + 1)
End If
If Dir(FN) <> "" Then
Kill (FN)
End If
#If Win64 Then
ST = GetTickCount64() 'start time
#Else
ST = GetTickCount() 'start time
#End If
'*************************************************
Success = DownloadSingleFile(SourceURL, FN, False) 'see function above this one
'*************************************************
If Not Success Then
DownloadSpeed = "Download failed"
Exit Function
End If
#If Win64 Then
ET = GetTickCount64() ' end time
#Else
ET = GetTickCount() ' end time
#End If
If Success And Dir(FN) <> "" Then
TT = (ET - ST) 'milliseconds taken
If Len(SourceURL) = 0 Then
FSize = 4514938880# * 8 'in bits, see size above
Else
'FSize = File_Size(FN) * 8 'in bits (function in separate module)
FSize = FileLen(FN) * 8 'in bits
End If
Debug.Print FSize & " bits took " & TT & " milliseconds to download"
If TT < 1000 Then ' under 1 second
Debug.Print "TT = " & Round(TT, 3)
Debug.Print "MultiplyBy = 1000 / Round(TT, 3) = " & Round(1000 / Round(TT, 3), 3)
MultiplyBy = Round(1000 / Round(TT, 3), 3)
FSize = FSize * MultiplyBy
Debug.Print "FSize * MultiplyBy = " & FSize
Debug.Print Round(FSize, 0) & " bits would take 1 second to download"
mbps = (Round(FSize, 0) / 1000000) 'divide by 1 million to return Mbps
' Debug.Print mbps & " Mbps (megabits per second)"
Else
Debug.Print "TT = " & Round(TT, 3)
Debug.Print "DivideBy = Round(TT, 3) / 1000 = " & Round(Round(TT, 3) / 1000, 3)
DivideBy = Round(Round(TT, 3) / 1000, 3)
FSize = FSize / DivideBy
Debug.Print "FSize / DivideBy = " & FSize
Debug.Print Round(FSize, 0) & " bits would take 1 second to download"
mbps = (Round(FSize, 0) / 1000000) 'divide by 1 million to return Mbps
End If
DownloadSpeed = Format(CStr(mbps), "####0.00")
If DeleteAfterTest Then
Kill (FN)
End If
End If
End Function
