如何使用TSL加密强制VB6发布？

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上发布文章。所有这些用户都使用BizTalk发布。

客户已经给我们到下周三修复我们的应用程序。所以，那些力量想让我强迫应用程序使用TSL。

通常，我对VB6没有问题，但我从未尝试过强制使用用于发布的加密。通常情况下，当我们发布其他VB6应用程序时，他们会自行与Windows进行协商，并负责处理问题。虽然我看到了在发送电子邮件时强迫VB6使用TSL的成功尝试，但我从未见过有人为POSTing使用TSL。

尽管如此，有谁知道如何在VB6时强制POSTing使用TSL？

谢谢

Answer 1

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