VisualFreeBasic通过WinHttp.dll实现Http/Https请求

魔都小强

已于 2023-05-05 15:27:18 修改

阅读量841

点赞数

文章标签： http https 服务器开发语言

于 2023-05-04 23:58:42 首次发布

本文链接：https://blog.csdn.net/meishow88/article/details/130497468

版权

VisualFreeBasic中自带了Http请求的操作，自带了三个函数Http_Get、Http_Post、Http_Upload。

'GET方法获取网页
'URL：字符串，目标域名或者IP地址+，目标页面的路径
'ref：字符串，引用页面
'user：字符串，用户名，如不需要则填空 对于FTP协议，默认值为“匿名”。
'pwd：字符串，密码，如不需要则填空
'b= Http_Get( "http://www.yfvb.com/port.php?c=do&ID=99")
#Include Once "win/wininet.bi"
'--------------------------------------------------------------------------
Function Http_Get(ByVal URL as String, ref as String = "", user as String = "", pwd as String = "") as String
   Dim Prot As INTERNET_PORT  '服务器上的传输控制协议/ Internet协议（TCP / IP）端口。FTP服务器的默认端口（端口21）。HTTP服务器的默认端口（端口80）,安全超文本传输协议（HTTPS）服务器的默认端口（端口443）。
   Dim ServerName as String  '指定Internet服务器的主机名。或者，字符串可以包含站点的IP地址，采用ASCII点分十进制格式（例如11.0.1.45）。
   Dim UrlPath as String     '路径，具体目标对象的名称。通常是文件名，可执行模块或搜索说明符。
   Dim sout as String '从服务器返回的内容数据
   URL_FenLiYuMinLuJing url, ServerName, UrlPath, Prot '分离成域名与路径
   '初始化应用程序对WinINet函数的使用。
   Dim hInet as HANDLE = InternetOpenA("Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)", INTERNET_OPEN_TYPE_DIRECT, Null, Null, 0)
   If hInet Then
      '打开给定站点的文件传输协议（FTP）或HTTP会话。
      Dim hConn as HANDLE = InternetConnectA(hInet, StrPtr(ServerName), Prot, StrPtr(user), StrPtr(pwd), INTERNET_SERVICE_HTTP, 0, 0)   ' INTERNET_SERVICE_FTP FTP服务
      If hConn Then
         '创建一个HTTP请求句柄。
         Dim G_HTTP_Accept(1) As ZString Ptr = {@"*/*",0}
         Dim hRequ as HANDLE = HttpOpenRequestA(hConn, @"GET", StrPtr(UrlPath), @"HTTP/1.1", StrPtr(ref), Cast(Any Ptr,@G_HTTP_Accept(0)), INTERNET_FLAG_RELOAD, 0)
         If hRequ Then
            '将指定的请求发送到HTTP服务器
            Dim bRequ as Integer = HttpSendRequestA(hRequ, NULL, -1, Null, 0)
            If bRequ Then
               Dim tstr as String 
               Dim bRead as ULong
               tstr = String(4097, 0)  '每次最大接收数据是 4097 ，这里只是读取网页等返回小量数据，如果接收文件或大量数据，效率低下。
               '从InternetOpenUrl， FtpOpenFile或 HttpOpenRequest函数打开的句柄中读取数据 。
               While InternetReadFile(hRequ, StrPtr(tstr), 4096, @bRead) AndAlso (bRead > 0)
                  sout &= Left(tstr, bRead)
               Wend
            EndIf
            InternetCloseHandle hRequ
         EndIf
         InternetCloseHandle hConn
      EndIf
      InternetCloseHandle(hInet)
   EndIf
   Return sout
End Function
Function Http_GetTest(ByVal URL as String) as Long '测试网络是不是连接正常，返回0 为不正常，非0 正常。
   Dim Prot As INTERNET_PORT  '服务器上的传输控制协议/ Internet协议（TCP / IP）端口。FTP服务器的默认端口（端口21）。HTTP服务器的默认端口（端口80）,安全超文本传输协议（HTTPS）服务器的默认端口（端口443）。
   Dim ServerName as String  '指定Internet服务器的主机名。或者，字符串可以包含站点的IP地址，采用ASCII点分十进制格式（例如11.0.1.45）。
   Dim UrlPath as String     '路径，具体目标对象的名称。通常是文件名，可执行模块或搜索说明符。
   URL_FenLiYuMinLuJing url, ServerName, UrlPath, Prot '分离成域名与路径
   '初始化应用程序对WinINet函数的使用。
   Dim hInet as HANDLE = InternetOpenA("Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)", INTERNET_OPEN_TYPE_DIRECT, Null, Null, 0)
   If hInet Then
      '打开给定站点的文件传输协议（FTP）或HTTP会话。
      Dim hConn as HANDLE = InternetConnectA(hInet, StrPtr(ServerName), Prot,NULL , NULL, INTERNET_SERVICE_HTTP, 0, 0)   ' INTERNET_SERVICE_FTP FTP服务
      If hConn Then
         '创建一个HTTP请求句柄。
         Dim G_HTTP_Accept(1) As ZString Ptr = {@"*/*",0}
         Dim hRequ as HANDLE = HttpOpenRequestA(hConn, @"GET", StrPtr(UrlPath), @"HTTP/1.1", NULL, Cast(Any Ptr,@G_HTTP_Accept(0)), INTERNET_FLAG_RELOAD, 0)
         If hRequ Then
            '将指定的请求发送到HTTP服务器
         
            Function =  HttpSendRequestA(hRequ, NULL, -1, Null, 0)
            InternetCloseHandle hRequ
         EndIf
         InternetCloseHandle hConn
      EndIf
      InternetCloseHandle(hInet)
   EndIf
End Function

这三个函数存在几个缺陷

1、wininet组件天生有缺陷，断网或者切换网络后wininet库还在使用断网前的socket资源，导致其后的请求超时

2、没有处理异常的操作，失败返回空，问题是Web请求是可以返回空的啊。。而且网络异常。。能告诉我错误的原因吗？

3、下载文件无进度，大文件下载无法得知进度。

4、无法设置Agent、Header，对于身份Token放在Header的请求无法实现

5、使用非80/443端口的请求，URL_FenLiYuMinLuJing返回的端口不正确

综上所述，我准备封装一个Class_WebClient的类，调用winhttp.dll，并且仿造.Net下面的WebClient的属性和方法。

目前封装类要注意这几个问题：

1、封装的时候，对于下载的进度，我暂时采用的是SendMessage的方法通知hWndForm属性对应的窗体，由于刚写FreeBasic的代码不久，对于回调和线程方面的知识储备不够。

2、FreeBasic的String类型，不能赋值为NULL，DownloadString和UploadString如果返回False表示请求异常，然后调用GetErrorMessage获取请求异常的信息，Html内容存在strContent中

#pragma once
#include once "windows.bi"
#include Once "crt/stdio.bi"

Type HINTERNET As LPVOID

#Ifndef CRLF
   #define CRLF Chr(10 ,13)
#endif

Type INTERNET_SCHEME As Long
Type INTERNET_PORT As WORD

Type URL_COMPONENTS
   dwStructSize     As DWORD
   lpszScheme       As LPWSTR
   dwSchemeLength   as DWORD
   nScheme          As INTERNET_SCHEME
   lpszHostName     as LPWSTR
   dwHostNameLength as DWORD
   nPort             As INTERNET_PORT
   lpszUserName      as LPWSTR
   dwUserNameLength  as DWORD
   lpszPassword      as LPWSTR
   dwPasswordLength  as DWORD
   lpszUrlPath       As LPWSTR
   dwUrlPathLength   as DWORD
   lpszExtraInfo     as LPWSTR
   dwExtraInfoLength as DWORD
End Type

Declare Function WinHttpOpen Lib "winhttp" Alias "WinHttpOpen"(sUserAgent As LPCWSTR, iAccessType As Long, sProxyName As LPCWSTR, sProxyBypass As LPCWSTR, iFlag As Long) As HINTERNET
Declare Function WinHttpCloseHandle Lib "winhttp" Alias "WinHttpCloseHandle"( __hWinHTTPLib As Any Ptr) As BOOLEAN
Declare Function WinHttpConnect Lib "winhttp" Alias "WinHttpConnect"(hSession As HINTERNET, sServerName As LPCWSTR, iServerPort As Long, Reserved As DWORD) As HINTERNET
Declare Function WinHttpOpenRequest Lib "winhttp" Alias "WinHttpOpenRequest"(hConnect As HINTERNET, sVerb As LPCWSTR, sObjectName As LPCWSTR, sVersion As LPCWSTR, sReferrer As LPCWSTR, pAcceptTypes As Any Ptr, iFlags As Long) As HINTERNET
Declare Function WinHttpSendRequest Lib "winhttp" Alias "WinHttpSendRequest"(HINTERNET As HINTERNET, strHeader As LPCWSTR, iHeadersLength As Long, pOptionalBuff As HINTERNET, iOptionalLength As Long, iTotalLength As Long, PCONTEXT As DWORD_PTR) As BOOLEAN
Declare Function WinHttpReceiveResponse Lib "winhttp" Alias "WinHttpReceiveResponse"(HINTERNET As HINTERNET, iReserved As LPVOID) As BOOLEAN
Declare Function WinHttpReadData Lib "winhttp" Alias "WinHttpReadData"(hRequest As HINTERNET, pBuffer As LPVOID, iNumberOfBytesToRead As Long, pNumberOfBytesRead As LPDWORD) As BOOLEAN
Declare Function WinHttpQueryDataAvailable Lib "winhttp" Alias "WinHttpQueryDataAvailable"(hRequest As HINTERNET, pNumberOfBytesAvailable As LPDWORD) As BOOLEAN
Declare Function WinHttpSetTimeouts Lib "winhttp" Alias "WinHttpSetTimeouts"(HINTERNET As HINTERNET, iResolveTimeout As Integer, iConnectTimeout As Integer, iSendTimeout As Integer, iReceiveTimeout As Integer) As BOOLEAN
Declare Function WinHttpCheckPlatform Lib "winhttp" Alias "WinHttpCheckPlatform"() As BOOLEAN
Declare Function WinHttpSetStatusCallback Lib "winhttp" Alias "WinHttpSetStatusCallback"(hConnect As HINTERNET, lpfnInternetCallback As Any Ptr, dwNotificationFlags As DWORD, dwReserved As DWORD_PTR) As Any Ptr
Declare Function WinHttpCrackUrl Lib "winhttp" Alias "WinHttpCrackUrl"(sURL As LPCWSTR, dwUrlLength As DWORD, dwFlags As DWORD, urlComp As URL_COMPONENTS Ptr)         As BOOLEAN
Declare Function WinHttpQueryOption Lib "winhttp" Alias "WinHttpQueryOption"(hRequest As HINTERNET, dwOption As DWORD, lpBuffer As DWORD, lpdwBufferLength As LPDWORD) As Long
Declare Function WinHttpSetOption Lib "winhttp" Alias "WinHttpSetOption"(hRequest As HINTERNET, dwOption As DWORD, lpBuffer As DWORD, dwBufferLength As DWORD)         As Long
Declare Function WinHttpQueryHeaders Lib "winhttp" Alias "WinHttpQueryHeaders"(hRequest As HINTERNET, dwInfoLevel As DWORD, pwszName As LPCWSTR, lpBuffer As LPVOID, lpdwBufferLength As LPDWORD, lpdwIndex As LPDWORD) As Long

Type Class_WebClient
   Private : 
   Dim __hWinHTTPLib  As Any Ptr = 0
   Dim __ErrorMessage As String  = ""
   Dim __Agent        As String  = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/105.0.0.0 Safari/537.36"
   Dim __Header       As String  = ""
   Dim __hWnd         As .hWnd
   Const MSG_DOWNING = WM_USER + 9999
   
   Const WINHTTP_ACCESS_TYPE_DEFAULT_PROXY     = 0
   Const WINHTTP_ACCESS_TYPE_NO_PROXY          = 1
   Const WINHTTP_ACCESS_TYPE_NAMED_PROXY       = 3
   Const WINHTTP_ACCESS_TYPE_AUTOMATIC_PROXY   = 4
   Const WINHTTP_FLAG_ESCAPE_DISABLE           = &H00000040
   Const INTERNET_DEFAULT_HTTPS_PORT           = 443
   Const INTERNET_DEFAULT_HTTP_PORT            = 80
   Const INTERNET_DEFAULT_PORT                 = 0
   Const WINHTTP_NO_PROXY_NAME                 = ""
   Const WINHTTP_NO_PROXY_BYPASS               = ""
   Const WINHTTP_NO_REFERER                    = ""
   Const WINHTTP_DEFAULT_ACCEPT_TYPES          = 0
   Const WINHTTP_FLAG_REFRESH                  = &H100
   Const WINHTTP_FLAG_SECURE                   = &H00800000
   Const WINHTTP_NO_ADDITIONAL_HEADERS         = ""
   Const WINHTTP_NO_REQUEST_DATA               = 0
   Const WINHTTP_CALLBACK_STATUS_REDIRECT      = &H00004000
   Const WINHTTP_OPTION_SECURITY_FLAGS         = 31
   Const SECURITY_FLAG_IGNORE_CERT_WRONG_USAGE = &H00000200
   Const WINHTTP_OPTION_SECURE_PROTOCOLS       = 84
   Const WINHTTP_QUERY_FLAG_NUMBER             = &H20000000
   Const WINHTTP_FLAG_SECURE_PROTOCOL_SSL2     = &H00000008
   Const WINHTTP_FLAG_SECURE_PROTOCOL_SSL3     = &H00000020
   Const WINHTTP_FLAG_SECURE_PROTOCOL_TLS1     = &H00000080
   Const WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_1   = &H00000200
   Const WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_2   = &H00000800
   Const WINHTTP_QUERY_CONTENT_LENGTH          = 5
   
   Declare Function _WinHttpStartup() As BOOL
   Declare Function _WinHttpCrackUrl(strUrl As Wstring, ByRef strScheme As String, ByRef strHost As String, ByRef nPort As Integer, ByRef strPathAndQuery As String) As BOOL
   Declare Function _HttpRequest(ByVal strUrl As String, ByRef strContent As String, ByVal strMethod As String = "GET", ByVal strData As String = "") As BOOL
   Public : 
   Declare Property hWndForm() As .hWnd
   Declare Property hWndForm(ByVal _hWnd As .hWnd)
   Declare Property Agent() As String
   Declare Property Agent(ByVal sText As String)
   Declare Function GetErrorMessage(ByVal strIn As String = "网络通信") As String
   Declare Function DownloadString(ByVal strUrl As String, ByRef strContent As String) As BOOL
   Declare Function UploadString(ByVal strUrl As String, ByRef strContent As String, ByVal strData As String) As BOOL
   Declare Function DownloadFile(ByVal strUrl As String, ByVal strFilePath As String, ByVal strMethod As String = "GET", ByVal strData As String = "") As BOOL
End Type

Property Class_WebClient.Agent() As String
   Return __Agent
End Property

Property Class_WebClient.Agent(ByVal sText As String)
   __Agent = sText
End Property

'用于发送下载文件的进度，用不上可以留空
Property Class_WebClient.hWndForm() As .hWnd                    '句柄
   Return __hWnd
End Property

Property Class_WebClient.hWndForm(ByVal hForm As .hWnd) '句柄
   __hWnd = hForm
End Property

Function Class_WebClient. _HttpRequest(ByVal strUrl As String, ByRef strContent As String, ByVal strMethod As String = "GET", ByVal strData As String = "") As BOOL
   Dim strScheme As String, strHost As String, nPort As Integer, strPathAndQuery As String
   Dim As BOOLEAN bResults
   Dim As Any Ptr hSession = 0, hConnect = 0, hRequest = 0
   Dim dwSizeDW As DWORD = SizeOf(dwSizeDW), dwContentSize As DWORD = 0, dwIndex As DWORD = 0
   
   _HttpRequest = False
   
   If Not _WinHttpCrackUrl(strUrl, strScheme, strHost, nPort, strPathAndQuery) Then
      __ErrorMessage = "Url解析失败"
      Exit Function
   End If
   
   hSession = WinHttpOpen(WStr( __Agent), WINHTTP_ACCESS_TYPE_DEFAULT_PROXY, WINHTTP_NO_PROXY_NAME, WINHTTP_NO_PROXY_BYPASS, 0)
   If hSession = 0 Then
      Exit Function
   End If
   
   hConnect = WinHttpConnect(hSession, WStr(strHost), nPort, 0)
   If hConnect = 0 Then
      Exit Function
   End If
   
   Dim dwFlags As DWORD = WINHTTP_FLAG_REFRESH
   If LCase(strScheme) = "https" Then
      dwFlags = dwFlags Or WINHTTP_FLAG_SECURE
   End If
   
   '开始发起请求
   hRequest = WinHttpOpenRequest(hConnect, WStr(strMethod), strPathAndQuery, NULL, WINHTTP_NO_REFERER, WINHTTP_DEFAULT_ACCEPT_TYPES, dwFlags)
   If hRequest = 0 Then
      Exit Function
   End If
   
   Dim strHeader As String = __Header
   '如果是POST，而且没设置过Header，则需要加一下，不然请求会失败
   If strMethod = UCase("POST") Then
      If strHeader = WINHTTP_NO_ADDITIONAL_HEADERS Then
         strHeader = "Content-Type: application/x-www-form-urlencoded" & CRLF
      End If
   End If
   
   'Dim wstrData As Wstring Ptr = WStr(strData)
   bResults = WinHttpSendRequest(hRequest, strHeader, Len(strHeader), StrPtr(strData), Len(strData), Len(strData), 0)
   If bResults = 0 Then
      Exit Function
   End If
   
   bResults = WinHttpReceiveResponse(hRequest, NULL)
   If bResults = 0 Then
      Exit Function
   End If
   
   Dim strTmp As String
   Dim As ULong dwSize = 0, dwDownloaded = 0
   
   Do
      dwSize   = 0
      bResults = WinHttpQueryDataAvailable(hRequest, @dwSize)
      If bResults = 0 Then
         Exit Function
      End If
      
      strTmp   = Space(dwSize)
      bResults = WinHttpReadData(hRequest, StrPtr(strTmp), dwSize, @dwDownloaded)
      If bResults = 0 Then
         Exit Function
      End If
      strContent += strTmp
      'fwrite(@aOutBuffer(0), SizeOf(aOutBuffer(0)), dwSize, f)
      
   Loop Until dwSize = 0
   Return True
End Function

'进度信息通过窗体的自定义消息发出来
Function Class_WebClient.DownloadFile(ByVal strUrl As String, ByVal strFilePath As String, ByVal strMethod As String = "GET", ByVal strData As String = "") As BOOL
   Dim strScheme As String, strHost As String, nPort As Integer, strPathAndQuery As String
   Dim As BOOLEAN bResults
   Dim As Any Ptr hSession = 0, hConnect = 0, hRequest = 0
   Dim dwSizeDW As DWORD = SizeOf(dwSizeDW), dwContentSize As DWORD = 0, dwIndex As DWORD = 0
   
   DownloadFile = False
   
   If Not _WinHttpCrackUrl(strUrl, strScheme, strHost, nPort, strPathAndQuery) Then
      __ErrorMessage = "Url解析失败"
      Exit Function
   End If
   
   hSession = WinHttpOpen(WStr( __Agent), WINHTTP_ACCESS_TYPE_DEFAULT_PROXY, WINHTTP_NO_PROXY_NAME, WINHTTP_NO_PROXY_BYPASS, 0)
   If hSession = 0 Then
      Exit Function
   End If
   
   hConnect = WinHttpConnect(hSession, WStr(strHost), nPort, 0)
   If hConnect = 0 Then
      Exit Function
   End If
   '下载文件，要先获取大小
   Dim dwFlags As DWORD = WINHTTP_FLAG_REFRESH
   If LCase(strScheme) = "https" Then
      dwFlags = dwFlags Or WINHTTP_FLAG_SECURE
   End If
   
   hRequest = WinHttpOpenRequest(hConnect, WStr("HEAD"), strPathAndQuery, NULL, WINHTTP_NO_REFERER, WINHTTP_DEFAULT_ACCEPT_TYPES, dwFlags)
   If hRequest = 0 Then
      Exit Function
   End If
   
   bResults = WinHttpSendRequest(hRequest, __Header, Len( __Header), WINHTTP_NO_REQUEST_DATA, 0, 0, 0)
   If bResults = 0 Then
      Exit Function
   End If
   
   bResults = WinHttpReceiveResponse(hRequest, 0)
   If bResults = 0 Then
      Exit Function
   End If
   
   bResults = WinHttpQueryHeaders(hRequest, WINHTTP_QUERY_CONTENT_LENGTH Or WINHTTP_QUERY_FLAG_NUMBER, NULL, @dwContentSize, @dwSizeDW, @dwIndex)
   If Not bResults Then
      dwContentSize = -1
   End If
   WinHttpCloseHandle(hRequest)
   
   '开始下载文件
   hRequest = WinHttpOpenRequest(hConnect, WStr(strMethod), strPathAndQuery, NULL, WINHTTP_NO_REFERER, WINHTTP_DEFAULT_ACCEPT_TYPES, dwFlags)
   If hRequest = 0 Then
      Exit Function
   End If
   
   Dim strHeader As String = __Header
   '如果是POST，而且没设置过Header，则需要加一下，不然请求会失败
   If strMethod = UCase("POST") Then
      If strHeader = WINHTTP_NO_ADDITIONAL_HEADERS Then
         strHeader = "Content-Type: application/x-www-form-urlencoded" & CRLF
      End If
   End If
   
   'Dim wstrData As Wstring Ptr = WStr(strData)
   bResults = WinHttpSendRequest(hRequest, strHeader, Len(strHeader), StrPtr(strData), Len(strData), Len(strData), 0)
   If bResults = 0 Then
      Exit Function
   End If
   
   bResults = WinHttpReceiveResponse(hRequest, NULL)
   If bResults = 0 Then
      Exit Function
   End If
   
   Dim As FILE Ptr f
   f = fopen(strFilePath, "wb")
   If f = 0 Then
      Exit Function
   End If
   
   Dim As ULong dwSize = 0, dwDownloaded, i, dDownLoading = 0
   Do
      dwSize   = 0
      bResults = WinHttpQueryDataAvailable(hRequest, @dwSize)
      
      If bResults = 0 Then
         Goto ExitDownLoadFile
      End If
      
      dDownLoading += dwSize
      If __hWnd Then
         SendMessage __hWnd, MSG_DOWNING, dDownLoading, dwContentSize
      End If
      ReDim As UByte aOutBuffer(dwSize + 1)
      
      bResults = WinHttpReadData(hRequest, @aOutBuffer(0), dwSize, @dwDownloaded)
      If bResults = 0 Then
         Goto ExitDownLoadFile
      End If
      fwrite(@aOutBuffer(0), SizeOf(aOutBuffer(0)), dwSize, f)
      
   Loop Until dwSize = 0
   ExitDownLoadFile : 
   fclose(f)
   If bResults = 0 Then
      Exit Function
   End If
   
   Return True
End Function

'下载成功返回字符串，下载失败返回NULL，错误描述可以调用GetErrorMessage
Function Class_WebClient.DownloadString(ByVal strUrl As String, ByRef strContent As String) As BOOL
   Return _HttpRequest(strUrl, strContent, "GET")
End Function

Function Class_WebClient.UploadString(ByVal strUrl As String, ByRef strContent As String, ByVal strData As String) As BOOL
   Return _HttpRequest(strUrl, strContent, "POST", strData)
End Function

Function Class_WebClient.GetErrorMessage(ByVal strIn As String = "网络请求") As String
   If __ErrorMessage <> "" Then Return strIn & "失败，错误描述：" & __ErrorMessage
   Dim nLastErrorID As DWORD = GetLastError()
   If nLastErrorID = 0     Then Return strIn & "失败，错误描述：未知"
   If nLastErrorID = 12175 Then Return strIn & "失败，错误代码：" & nLastErrorID & "，错误描述：此网站https协议要求TLS1.2。"
   'Print "Win7下不支持TLS1.2协议，需要更新补丁http://www.catalog.update.microsoft.com/search.aspx?q=kb3140245"
   'https://support.microsoft.com/en-us/topic/update-to-enable-tls-1-1-and-tls-1-2-as-default-secure-protocols-in-winhttp-in-windows-c4bd73d2-31d7-761e-0178-11268bb10392
   Return strIn & "失败，错误代码：" & nLastErrorID & "，错误描述：" & AfxGetWinErrMsg(nLastErrorID)
End Function

Function Class_WebClient. _WinHttpCrackUrl(strUrl As Wstring, ByRef strScheme As String, ByRef strHost As String, ByRef nPort As Integer, ByRef strPathAndQuery As String) As BOOL
   Dim urlComp As URL_COMPONENTS
   
   With urlComp
      .dwSchemeLength    = -1
      .dwHostNameLength  = -1
      .dwUrlPathLength   = -1
      .dwExtraInfoLength = -1
      .dwStructSize      = SizeOf(urlComp)
   End With
   
   If Not WinHttpCrackUrl(strUrl, Len(strUrl), 0, Varptr(urlComp)) Then
      Return False
   End If
   
   strScheme = wStrToStr(urlComp.lpszScheme, urlComp.dwSchemeLength)
   strHost   = wStrToStr(urlComp.lpszHostName, urlComp.dwHostNameLength)
   nPort     = urlComp.nPort
   If urlComp.dwExtraInfoLength = 0 Then
      strPathAndQuery = wStrToStr(urlComp.lpszUrlPath, urlComp.dwUrlPathLength)
   Else
      strPathAndQuery = wStrToStr(urlComp.lpszUrlPath, urlComp.dwUrlPathLength) + wStrToStr(urlComp.lpszExtraInfo, urlComp.dwExtraInfoLength)
   End If
   Return True
End Function

Get请求获取Html内容调用演示：

Dim http As Class_WebClient
Dim strContent As String
If Not http.DownloadString("https://www.taobao.com/", strContent) Then
    MsgBox http.GetErrorMessage()
Else
    MsgBox strContent
End If

Get请求下载文件调用演示：

Dim http As Class_WebClient

If Not http.DownloadString("https://www.taobao.com/") Then
    MsgBox http.GetErrorMessage()
Else
    MsgBox "下载成功"
End If