Private Const MAX_PATH As Long = 260
         
'Identifies the platform for which the DLL was built.
Private Const DLLVER_PLATFORM_WINDOWS As Long = &H1  'Windows 95
Private Const DLLVER_PLATFORM_NT As Long = &H2       'Windows NT

Private Type DllVersionInfo
   cbSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformID As Long
End Type

Private Type VS_FIXEDFILEINFO
   dwSignature As Long
   dwStrucVersion As Long
   dwFileVersionMS As Long
   dwFileVersionLS As Long
   dwProductVersionMS As Long
   dwProductVersionLS As Long
   dwFileFlagsMask As Long
   dwFileFlags As Long
   dwFileOS As Long
   dwFileType As Long
   dwFileSubtype As Long
   dwFileDateMS As Long
   dwFileDateLS As Long
End Type


Private Declare Function DllGetVersion Lib "shlwapi" _
  (dwVersion As DllVersionInfo) As Long
  
Private Declare Function GetSystemDirectory Lib "kernel32" _
   Alias "GetSystemDirectoryA" _
  (ByVal lpBuffer As String, _
   ByVal nSize As Long) As Long

Private Declare Function GetFileVersionInfoSize Lib "version.dll" _
   Alias "GetFileVersionInfoSizeA" _
  (ByVal lptstrFilename As String, _
   lpdwHandle As Long) As Long

Private Declare Function GetFileVersionInfo Lib "version.dll" _
   Alias "GetFileVersionInfoA" _
  (ByVal lptstrFilename As String, _
   ByVal dwHandle As Long, _
   ByVal dwLen As Long, _
   lpData As Any) As Long
   
Private Declare Function VerQueryValue Lib "version.dll" _
   Alias "VerQueryValueA" _
  (pBlock As Any, _
   ByVal lpSubBlock As String, _
   FI As Any, nVerSize As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, _
   Source As Any, _
   ByVal Length As Long)
   
Private Declare Function lstrcpyA Lib "kernel32" _
  (ByVal RetVal As String, ByVal Ptr As Long) As Long
                        
Private Declare Function lstrlenA Lib "kernel32" _
  (ByVal Ptr As Any) As Long
  

Private Sub Command1_Click()

   Dim DVI As DllVersionInfo
   Call GetIEVersion(DVI)
   
   Frame1.Caption = GetIEVersionString()
   Label2(0).Caption = DVI.dwMajorVersion
   Label2(1).Caption = DVI.dwMinorVersion
   Label2(2).Caption = DVI.dwBuildNumber
   Label2(3).Caption = DVI.dwPlatformID
   Label2(4).Caption = GetDLLPlatformName(DVI.dwPlatformID)
   Label2(5).Caption = GetIECypherVersion()
   
End Sub
  
  
Private Function GetIECypherVersion() As String

   Dim FI As VS_FIXEDFILEINFO
   Dim sBuffer() As Byte
   Dim nBufferSize As Long
   Dim lpBuffer As Long
   Dim nVerSize As Long
   Dim nUnused As Long
   Dim tmpVer As String
   Dim sBlock As String
   Dim sDLLFile As String
   Dim sSysPath As String
   
   sSysPath = GetSystemDir()

   If Len(sSysPath) > 0 Then

     'set file that has the encryption level
     'info and call to get required size
      sDLLFile = sSysPath & "\schannel.dll"
      nBufferSize = GetFileVersionInfoSize(sDLLFile, nUnused)
      
      ReDim sBuffer(nBufferSize)
      
      If nBufferSize > 0 Then
      
        'get the version info
         Call GetFileVersionInfo(sDLLFile, 0&, nBufferSize, sBuffer(0))
         Call VerQueryValue(sBuffer(0), "\", lpBuffer, nVerSize)
         Call CopyMemory(FI, ByVal lpBuffer, Len(FI))
   
         If VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", lpBuffer, nVerSize) Then
            
            If nVerSize Then
               tmpVer = GetPointerToString(lpBuffer, nVerSize)
               tmpVer = Right("0" & Hex(Asc(Mid(tmpVer, 2, 1))), 2) & _
                        Right("0" & Hex(Asc(Mid(tmpVer, 1, 1))), 2) & _
                        Right("0" & Hex(Asc(Mid(tmpVer, 4, 1))), 2) & _
                        Right("0" & Hex(Asc(Mid(tmpVer, 3, 1))), 2)
               sBlock = "\StringFileInfo\" & tmpVer & "\FileDescription"
               
              'Get predefined version resources
               If VerQueryValue(sBuffer(0), sBlock, lpBuffer, nVerSize) Then
               
                  If nVerSize Then
                  
                    'get the file description string
                     tmpVer = GetStrFromPtrA(lpBuffer)
                     
                    'File versions for 40 and 128-bit releases can
                    'be the same, so we have to do a string search
                    'to determine the encryption level. If the file
                    'description contains the line:
                    'PCT/SSL Security Provider (Export Version), 
                    'it is 40-bit. If it contains the line:
                    'PCT/SSL Security Provider (US and Canada 
                    'use Only), it is 128-bit.
                    
                     Select Case InStr(1, tmpVer, "(US and Canada Use Only)", vbTextCompare)
                        Case 0:    GetIECypherVersion = "40-bit normal encryption"
                        Case Else: GetIECypherVersion = "128-bit strong encryption"
                     End Select
                     
                  End If  'If nVerSize
               End If  'If VerQueryValue
            End If  'If nVerSize
         End If  'If VerQueryValue
      
      Else
      
         GetIECypherVersion = "schannel.dll is not in the system folder."
      
      End If  'If nBufferSize
   End If  'If sSysPath

End Function



Private Function GetPointerToString(lpString As Long, nBytes As Long) As String

   Dim Buffer As String
   
   If nBytes Then
      Buffer = Space(nBytes)
      CopyMemory ByVal Buffer, ByVal lpString, nBytes
      GetPointerToString = Buffer
   End If
   
End Function


Private Function GetStrFromPtrA(ByVal lpszA As Long) As String

   GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
   Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
   
End Function


Private Function GetSystemDir() As String

    Dim nSize As Long
    Dim tmp As String
    
    tmp = Space$(MAX_PATH)
    nSize = Len(tmp)
    Call GetSystemDirectory(tmp, nSize)
    
    GetSystemDir = TrimNull(tmp)
    
End Function


Private Function TrimNull(item As String)

    Dim pos As Integer
   
   'double check that there is a chr$(0) in the string
    pos = InStr(item, Chr$(0))
    If pos Then
       TrimNull = Left$(item, pos - 1)
    Else
       TrimNull = item
    End If
  
End Function


Private Function GetIEVersion(DVI As DllVersionInfo) As Long
   
   DVI.cbSize = Len(DVI)
   Call DllGetVersion(DVI)
   GetIEVersion = DVI.dwMajorVersion
   
End Function


Private Function GetDLLPlatformName(dwPlatform As Long) As String
   
   Select Case dwPlatform
   Case DLLVER_PLATFORM_WINDOWS: GetDLLPlatformName = "DLL built for Windows 95"
   Case DLLVER_PLATFORM_NT:      GetDLLPlatformName = "DLL built for Windows NT"
   End Select

End Function


Private Function GetIEVersionString() As String
   
   Dim DVI As DllVersionInfo
   
   DVI.cbSize = Len(DVI)
   Call DllGetVersion(DVI)

   GetIEVersionString = "Internet Explorer " & DVI.dwMajorVersion & "." & _
                        DVI.dwMinorVersion & "." & _
                        DVI.dwBuildNumber
   
End Function