Learning from our experience with BCryptEnumAlgorithms, we can enumerate the Cipher Suites supported by Schannel our system (43 on my system).
J.A. Coutts
J.A. Coutts
Code:
Option Explicit
'================================
'EVENTS
'================================
Public Event Error(ByVal Number As Long, Description As String, ByVal Source As String)
Private Const MS_SCHANNEL_PROVIDER As String = "Microsoft SSL Protocol Provider"
Private Const NCRYPT_SSL_MAX_NAME_SIZE As Long = 64
Private Type NCRYPT_SSL_CIPHER_SUITE
dwProtocol As Long
dwCipherSuite As Long
dwBaseCipherSuite As Long
szCipherSuite(NCRYPT_SSL_MAX_NAME_SIZE) As Byte
szCipher(NCRYPT_SSL_MAX_NAME_SIZE) As Byte
dwCipherLen As Long
dwCipherBlockLen As Long 'in bytes
szHash(NCRYPT_SSL_MAX_NAME_SIZE) As Byte
dwHashLen As Long
szExchange(NCRYPT_SSL_MAX_NAME_SIZE) As Byte
dwMinExchangeLen As Long
dwMaxExchangeLen As Long
szCertificate(NCRYPT_SSL_MAX_NAME_SIZE) As Byte
dwKeyType As Long
End Type
'CNG API Declares
Private Declare Function SslOpenProvider Lib "ncrypt.dll" (ByRef hSslProvider As Long, ByVal pszProviderName As Long, ByVal dwFlags As Long) As Long
Private Declare Function SslFreeObject Lib "ncrypt.dll" (ByVal hObject As Long, ByVal dwFlags As Long) As Long
Private Declare Function SslEnumCipherSuites Lib "ncrypt.dll" (ByVal hSslProvider As Long, ByVal hPrivateKey As Long, ByRef ppCipherSuite As Long, ByRef ppEnumState As Long, ByVal dwFlags As Long) As Long
Private Declare Function SslFreeBuffer Lib "ncrypt.dll" (ByVal pvBuffer As Long) As Long
'API memory functions
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynW" (ByVal lpStringDest As Long, ByVal lpStringSource As Long, ByVal iMaxLength As Long) As Long
'Constants for Cryptography API error messages
Private Const SOP As String = "SslOpenProvider"
Private Const SECS As String = "SslEnumCipherSuites"
Public Function Test1() As Boolean
Const Routine As String = "clsSSL.Test1"
Dim hSslProvider As Long
Dim ppCipherSuite As Long 'NCRYPT_SSL_CIPHER_SUITE
Dim ppEnumState As Long
Dim lRet As Long
Dim NameLen As Long
Dim CipherName As String
Dim N%
lRet = SslOpenProvider(hSslProvider, StrPtr(MS_SCHANNEL_PROVIDER), 0)
If lRet <> 0 Then
RaiseEvent Error(lRet, SOP, Routine)
GoTo ReleaseHandles
End If
While SslEnumCipherSuites(hSslProvider, 0&, ppCipherSuite, ppEnumState, 0) = 0
NameLen = lstrlen(ppCipherSuite + 12)
CipherName = Space$(NameLen)
lstrcpyn StrPtr(CipherName), ppCipherSuite + 12, NameLen + 1
Debug.Print CipherName
Wend
ReleaseHandles:
SslFreeBuffer ppCipherSuite
SslFreeObject hSslProvider, 0
End Function