vb6 - 如何强制 VB6 使用 TSL 加密进行 POST？

Question

我工作的公司有一个旧的 VB6 应用程序，他们想强制使用 TSL，而不是 SSL。我查看了代码，并告诉他们应该没问题。该代码使用 HTTPS 向客户端网站发布消息。它没有指定要使用的加密方式。

这是相关代码:

Sub PostXML()

Dim XMLHttpRequest  As MSXML2.XMLHTTP
Dim TempString      As String
Dim strURL          As String
Dim strArgs         As String


strURL = gPostWebServer & "/" & gPostFile

'ARB 1/8/2004 This is to trap if send fails and allow it to continue.
On Error GoTo errorHandler:

If Not XMLHttpRequest Is Nothing Then Set XMLHttpRequest = Nothing

Set XMLHttpRequest = New MSXML2.XMLHTTP

strArgs = "?Username=" & gPostUserName & "&Password=" & gPostPassword

XMLHttpRequest.Open "POST", strURL & strArgs, False

XMLHttpRequest.send dom_GlobalXMLObject

If XMLHttpRequest.Status >= 400 And XMLHttpRequest.Status <= 599 Then
    TempString = "Client Website is not available. Order was not posted successfully ..."
    flgOrderPostSuccess = False
    strOrderPostError = TempString
Else
    TempString = XMLHttpRequest.responseText

    'Parse the response
    Dim sValid          As String
    Dim sComments       As String
    Dim sTimeStamp      As String

    Dim oRoot           As MSXML2.IXMLDOMElement
    Dim lNodes          As MSXML2.IXMLDOMNodeList
    Dim oNodes          As MSXML2.IXMLDOMElement
    Dim lNodes1         As MSXML2.IXMLDOMNodeList
    Dim oNodes1         As MSXML2.IXMLDOMElement
    Dim lNodes2         As MSXML2.IXMLDOMNodeList
    Dim oNodes2         As MSXML2.IXMLDOMElement

    Call Set_Global_XML_Object
    dom_GlobalXMLObject.loadXML (TempString)

    dom_GlobalXMLObject.Save (Report_Folder & "\Response.xml")

    'Get the root of the XML tree.
    Set oRoot = dom_GlobalXMLObject.documentElement
    If Not oRoot Is Nothing Then
        Set lNodes = oRoot.childNodes

        For Each oNodes In lNodes
            Select Case oNodes.nodeName
                Case "Acknowledgement"
                    Set lNodes1 = oNodes.childNodes
                    For Each oNodes1 In lNodes1
                        Select Case oNodes1.nodeName
                            Case "Received"
                                sTimeStamp = Trim(oNodes1.nodeTypedValue)
                            Case "Validated"
                                sValid = Trim(oNodes1.nodeTypedValue)
                            Case "Errors"
                                Set lNodes2 = oNodes1.childNodes
                                For Each oNodes2 In lNodes2
                                    Select Case oNodes2.nodeName
                                        Case "Description"
                                            sComments = sComments & vbCrLf & Trim(oNodes2.nodeTypedValue)
                                    End Select
                                    Set oNodes2 = Nothing
                                Next
                                Set lNodes2 = Nothing
                        End Select
                        Set oNodes1 = Nothing
                    Next
                    Set lNodes1 = Nothing
            End Select
        Next
        If UCase(sValid) = "YES" Then
            TempString = sTimeStamp & " " & "Order uploaded successfully"
            flgOrderPostSuccess = True
            strOrderPostError = ""
        Else
            TempString = "Order had following problems:" & vbCrLf
            TempString = TempString & sComments
            strOrderPostError = TempString
        End If
    Else    'Non XML response
        TempString = Replace(TempString, vbCr, vbCrLf)
        TempString = "Order had following problems:" & vbCrLf & TempString
        strOrderPostError = TempString
    End If
End If

Call FillLogTextBox("-----------------------------------------------" & vbCr)
Call FillLogTextBox(TempString)
Call FillLogTextBox("-----------------------------------------------" & vbCr)

Set oRoot = Nothing
Set lNodes = Nothing
Set oNodes = Nothing
Set lNodes1 = Nothing
Set oNodes1 = Nothing
Set lNodes2 = Nothing
Set oNodes2 = Nothing

Set XMLHttpRequest = Nothing

Exit Sub

errorHandler:
TempString = Err.DESCRIPTION
If InStr(1, TempString, "Method") > 0 Or InStr(1, Err.DESCRIPTION, "failed") > 0 Then
    TempString = "Client Website was not found. Order was not posted successfully..."
    Call FillLogTextBox(TempString)
    Call FillLogTextBox("-----------------------------------------------" & vbCr)
    Exit Sub
End If

End Sub

当客户端上周末从 SSL 切换到 TSL 时，一切正常，除了来自这个旧 VB6 应用程序的帖子。 (无论如何，有人告诉我。这不是我以前支持的应用程序。)

我维护了其他 VB6 应用程序，但没有一个应用程序使用 VB6 进行 POST。他们都使用 BizTalk 进行发布。

客户要求我们在下周三之前修复我们的应用程序。因此，当权者希望我强制该应用程序使用 TSL。

通常，我在使用 VB6 时没有问题，但我从未尝试过强制对 POST 进行加密。通常，当我们从其他 VB6 应用程序中执行 POST 时，他们会自行与 Windows 协商，并处理好事情。虽然我看到在发送电子邮件时强制 VB6 使用 TSL 的成功尝试，但我从未见过有人这样做是为了 POST。

综上所述，有谁知道如何在 POST 时强制 VB6 使用 TSL？

谢谢

Answer 1

使用 SChannel，您无法在应用程序级别控制可用/使用的协议(protocol)和密码，您必须在系统级别的 Win2003 机器上配置 SChannel 协议(protocol)/密码。这是关于该主题的知识库文章:http://support.microsoft.com/kb/245030

要为入站和出站连接禁用 SSLv3，请在注册表中合并如下内容(并重新启动):

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders\SCHANNEL\Protocols\SSL 3.0]

[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders\SCHANNEL\Protocols\SSL 3.0\Client]
"DisabledByDefault"=dword:00000001
"Enabled"=dword:00000000

[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders\SCHANNEL\Protocols\SSL 3.0\Server]
"Enabled"=dword:00000000
"DisabledByDefault"=dword:00000001

同时确保 SSLv2 也被破坏。

您可能更喜欢使用 IISCrypto -- 一个很好的实用程序，使 SSL/TLS 协议(protocol)/密码注册表配置变得简单。