如何强制 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 这样做。

说了这么多，有谁知道如何强制 VB6 在 POST 时使用 TSL？

谢谢

Answer 1

使用 SChannel，您无法在应用程序级别控制可用/使用的协议和密码，您必须在系统级别的 Win2003 机器上配置 SChannel 协议/密码。这是有关该主题的知识库：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 协议/密码注册表配置变得简单。