How do I force VB6 to POST using TSL encryption?

The company I work for has an old VB6 application that they want to force to use TSL and not SSL. I looked at the code and told them everything should be fine. The code makes a message to the client's website using HTTPS. It does not specify which 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 over the weekend, everything worked, except for messages from that old VB6 application. (So ​​I was told one way or another. This is not an app that I have supported before.)

We have other VB6 apps that I support, but none of them POST from VB6. They all use BizTalk for publishing.

The client provided us until next Wednesday to fix our application. So, the credentials that want me to force the application to use TSL.

I usually have no problem with VB6, but I have never tried using the encryption used for POST. Typically when we did POST from other VB6 applications, they negotiated with Windows on their own and took care of things. While I've seen successful attempts to get VB6 to use TSL when sending email, I've never seen anyone do it for POSTing.

All that said, does anyone know how to get VB6 to use TSL on POSTING?

thank

+3


source to share


1 answer


With SChannel you cannot control the available / used protocols and ciphers at the application level, you need to configure the SChannel protocols / ciphers in the Win2003 box at the system level. Here's a KB on the topic: http://support.microsoft.com/kb/245030

To disable SSLv3 for both inbound and outbound connections, merge something like this into the registry (and reload):

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

      



In the meantime, make sure SSLv2 is shorted too.

You might want to use IISCrypto , a nice utility that makes it easy to register SSL / TLS protocols / ciphers.

+5


source







All Articles