How do I force VB6 to POST using TSL encryption?

Question

The company where I work has an old VB6 application that they want to force to use TSL, rather than SSL. I looked at the code, and told them they should be fine. The code does a post to the client website using HTTPS. It doesn't specify what encryption to use.

This is the relevant code:

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

When the client switched from SSL to TSL last weekend, everything worked, except the posts from this one old VB6 app. (So I'm told, anyways. This isn't an application I've supported before.)

We have other VB6 apps that I maintain, but none do a POST out of VB6. All of them use BizTalk for posting.

The client has given us until next Wednesday to fix our app. So, the powers that be want me to force the app to use TSL.

Normally, I don't have problems with VB6, but I've never tried forcing the encryption used to POST. Generally, when we did POST out of the other VB6 apps, they negotiated with Windows on their own, and took care of things. While I've seen successful attempts to force VB6 to use TSL when sending an email, I've never seen anyone do it for POSTing.

All that being said, does anyone know how to force VB6 to use TSL when POSTing?

Thanks

Answer 1

With SChannel you cannot control available/used protocols and ciphers at an application level, you have to configure SChannel protocols/ciphers on the Win2003 box at system level. Here is KB on the subject: http://support.microsoft.com/kb/245030

To disable SSLv3 for both inbound and outbound connections merge something like this in registry (and reboot):

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

While there make sure SSLv2 is nuked too.

You might prefer to use IISCrypto -- a nice utility that makes SSL/TLS protocols/ciphers registry config trivial.