VB6实现HTTPS网址TXT文件内容读取的代码求助

原代码使用MSXML2.XMLHTTP时出现"Error Occurred in the Secure Channel Support"，核心原因是该组件默认不支持现代HTTPS站点要求的TLS 1.2/1.3协议。以下是修改后的可运行源码：

修改后的完整代码 #

Private Function GetHttpText(ByVal URL As String) As ADODB.Stream
    Dim Req As MSXML2.ServerXMLHTTP.6.0
    Dim CharSet As String
    Dim CharsetPos As Long
    Dim LineSeparator As LineSeparatorEnum

    Set Req = New MSXML2.ServerXMLHTTP.6.0
    Set GetHttpText = New ADODB.Stream
    
    ' 配置支持TLS 1.1和TLS 1.2协议
    Req.SetOption 2, 13056 ' SXH_OPTION_USE_SSL_TLSv1_1 (2048) + SXH_OPTION_USE_SSL_TLSv1_2 (10240)
    
    ' 若需忽略证书错误（仅测试环境使用，生产环境不推荐）
    ' Req.SetOption 3, SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS

    With GetHttpText
        .Open
        .Type = adTypeBinary
        With Req
            .Open "GET", URL, False
            .send
            CharSet = LCase$(.getResponseHeader("CONTENT-TYPE"))
        End With
        .Write Req.responseBody
        CharsetPos = InStr(CharSet, "charset")
        If CharsetPos Then
            CharSet = Split(Mid$(CharSet, CharsetPos), "=")(1)
        Else
            ' 默认使用UTF-8
            CharSet = "utf-8"
        End If
        If CharSet = "utf-8" Then
            LineSeparator = adLF
        Else
            LineSeparator = adCRLF
        End If
        .Position = 0
        .Type = adTypeText
        .CharSet = CharSet
        .LineSeparator = LineSeparator
    End With
End Function

Private Sub DumpTextLineByLine()
    With GetHttpText("https://textfiles.com/art/simpsons.txt")
        Do Until .EOS
            Text1.SelText = .ReadText(adReadLine)
            Text1.SelText = vbNewLine
        Loop
        .Close
    End With
End Sub

关键修改说明 #

• 替换MSXML2.XMLHTTP为MSXML2.ServerXMLHTTP.6.0：该组件支持更丰富的安全协议配置，适配现代HTTPS要求。
• 添加协议配置：通过SetOption启用TLS 1.1和TLS 1.2，确保与HTTPS站点的协议兼容。
• 保留原有的字符集处理和流操作逻辑，保证文本内容的正确解析和输出。

注意事项 #

1. 确保VB6工程中已引用Microsoft XML, v6.0和Microsoft ActiveX Data Objects 2.8 Library（或更高版本）。
2. 生产环境请勿启用证书忽略选项，若站点证书不被系统信任，需先安装对应根证书。

内容的提问来源于stack exchange，提问作者Tobyy Damian