测试一下宽带的下载速度

Option Explicit

'vb代替inet控件获得网页源代码（解决代码不完整的问题）
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const scUserAgent = "Microsoft Internet Explorer 6.0"
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const HTTP_QUERY_RAW_HEADERS = 21&
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, sBuffer As Any, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByVal sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer

'判断当前是否连接网络API实现
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwFlags As Long, ByVal dwReserved As Long) As Long 'InternetGetConnectedState(0,0)=1 联网

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000

Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3

Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const FILE_SHARE_DELETE = &H4

Private Declare Function CreateFile Lib "KERNEL32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "KERNEL32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function WriteFile Lib "KERNEL32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function FlushFileBuffers Lib "KERNEL32" (ByVal hFile As Long) As Long
Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
'WriteFile(hFile, ByVal StrPtr(StrConv("12341", vbFromUnicode)), 2, lFileSize, ByVal 0) 读写时要转换成ANSI,并且lpOverlapped要传byval 0

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long) As Long
Private Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByVal lBufferLength As Long) As Long

Private Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
Private Const INTERNET_DOWNLOAD_BUFFER_SIZE = 2048&

Private Const CP_UTF8 = 65001
Private Declare Function MultiByteToWideChar Lib "KERNEL32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

Private Declare Sub ZeroMemory Lib "KERNEL32" Alias "RtlZeroMemory" (ByRef dest As Any, ByVal numBytes As Long)

Dim bFinish As Boolean
Dim dbltimer As Double
'使用API写文件,VB的文件操作对长文件名支持不好！
Public Function internetDownLoad(ByVal sUrl As String, Optional ByVal sFileName As String, Optional ByVal bUTF8 As Boolean) As String
    Dim hInetConnect As Long, hInetFile As Long 'internet连接句柄、file句柄
    Dim sHttpHeads As String, lFileSize As Double, sCharset As String
    Dim hFile As Long
    Dim sData As String, iRetLen As Long
    hInetConnect = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    If hInetConnect = 0 Then
        internetDownLoad = "Err:无法创建连接"
        Exit Function
    End If
    
    Call InternetSetOption(hInetConnect, INTERNET_OPTION_CONNECT_TIMEOUT, 10000&, 4)
'    If InternetQueryOption(hInetConnect, INTERNET_OPTION_CONNECT_TIMEOUT, iRetLen, 4) = 1 Then
'    End If
    bFinish = False
    hInetFile = InternetOpenUrl(hInetConnect, sUrl, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
    If hInetFile = 0 Then
        internetDownLoad = "Err:无法连接服务器"
        Call InternetCloseHandle(hInetConnect)
        Exit Function
    End If
    
     '读取文件大小及字符集
    sHttpHeads = String(2048, vbNullChar)
    If HttpQueryInfo(hInetFile, HTTP_QUERY_RAW_HEADERS, sHttpHeads, 2048, 0) = 1 Then
        sHttpHeads = Left(sHttpHeads, InStr(2, sHttpHeads, vbNullChar + vbNullChar + vbNullChar) - 1)
        lFileSize = IIf(InStr(sHttpHeads, "Content-Length:") = 0, Len(sHttpHeads), InStr(sHttpHeads, "Content-Length:")) + Len("Content-Length:")
        lFileSize = CDec("0" & Trim(Mid(sHttpHeads, lFileSize, IIf(InStr(lFileSize, sHttpHeads, vbNullChar) > lFileSize, InStr(lFileSize, sHttpHeads, vbNullChar) - lFileSize, 0))))
        sCharset = Mid(sHttpHeads, IIf(InStr(sHttpHeads, "charset=") > 0, InStr(sHttpHeads, "charset="), Len(sHttpHeads)) + Len("charset="))
        sCharset = LCase(Left(sCharset, IIf(InStr(sCharset, vbNullChar) > 0, InStr(sCharset, vbNullChar) - 1, Len(sCharset))))
    End If
    '存盘
     If Not sFileName = "" Then
         hFile = CreateFile(sFileName, GENERIC_READ + GENERIC_WRITE, 0, ByVal 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, ByVal 0)
         If hFile = -1 Then
             internetDownLoad = "Err:无法创建文件【" & sFileName & "】,请检查文件名是否合法或文件已经存在！"
             Call CloseHandle(hFile)
             Call InternetCloseHandle(hInetFile)
             Exit Function
         End If
     End If
     '设置缓冲区
    sData = String(INTERNET_DOWNLOAD_BUFFER_SIZE, vbNullChar)
    Do
        '清缓存
        Call ZeroMemory(ByVal StrPtr(sData), INTERNET_DOWNLOAD_BUFFER_SIZE)
        Call InternetReadFile(hInetFile, ByVal StrPtr(sData), INTERNET_DOWNLOAD_BUFFER_SIZE, iRetLen)
        If iRetLen < INTERNET_DOWNLOAD_BUFFER_SIZE Then
            sData = Left(sData, iRetLen)
        End If
        If Not (hFile = 0) Then
            Call WriteFile(hFile, ByVal StrPtr(sData), iRetLen, iRetLen, ByVal 0)
        Else
            'internetDownLoad = internetDownLoad + sData
            
            If Abs(Timer - dbltimer) > 1 Then
             Me.Cls
             Me.Print Time, lFileSize
             dbltimer = Timer
            End If
        End If
        lFileSize = lFileSize - INTERNET_DOWNLOAD_BUFFER_SIZE
        DoEvents
    Loop Until iRetLen < INTERNET_DOWNLOAD_BUFFER_SIZE Or Command1.Caption = "结束"
    
    If (hFile = 0) Then
       If bUTF8 Or sCharset = "utf-8" Then
        iRetLen = MultiByteToWideChar(CP_UTF8, 1, ByVal StrPtr(internetDownLoad), Len(internetDownLoad), ByVal 0, 0)
        sData = String(iRetLen, vbNullChar)
        Call MultiByteToWideChar(CP_UTF8, 1, ByVal StrPtr(internetDownLoad), Len(internetDownLoad), ByVal StrPtr(sData), iRetLen)
        internetDownLoad = sData: sData = ""
       Else
        internetDownLoad = StrConv(internetDownLoad, vbUnicode)
       End If
    End If
    
    If Not (hFile = 0) Then Call CloseHandle(hFile)
    If Not (hInetFile = 0) Then Call InternetCloseHandle(hInetFile)
    If Not (hInetConnect = 0) Then Call InternetCloseHandle(hInetConnect)
    bFinish = True
End Function


Private Sub Command1_Click()
     Command1.Caption = IIf(Command1.Caption = "结束", "开始", "结束")
End Sub

Private Sub Form_Load()
bFinish = True
End Sub

Private Sub Timer1_Timer()
    If bFinish Then
        Me.Caption = Val(Me.Caption) + 1
        Call internetDownLoad("https://catalog.s.download.windowsupdate.com/d/msdownload/update/software/updt/2020/06/windows10.0-kb4567512-arm64_2fcba2e7ec066dae14740efeb1b7e939fce6193b.msu")
    Else
        CurrentX = 0: CurrentY = 0
        Print Time
    End If
End Sub

这个不会骗人！