' API Calls for getting a file's version information
Private Type FileVersion
  FileVersion As String               ' Full file version as a string
  FileVersionMSl As Integer           ' File version MSB Low
  FileVersionMSh As Integer           ' File version MSB High
  FileVersionLSl As Integer           ' File version LSB Low
  FileVersionLSh As Integer           ' File version LSB High
  ProductVersion As String            ' File product version as a string
  ProductVersionMSl As Integer        ' Product version MSB low
  ProductVersionMSh As Integer        ' Product version MSB high
  ProductVersionLSl As Integer        ' Product version LSB low
  ProductVersionLSh As Integer        ' Product version LSB high
End Type

Private Type VS_FIXEDFILEINFO
   dwSignature As Long
   dwStrucVersionl As Integer
   dwStrucVersionh As Integer
   dwFileVersionMSl As Integer
   dwFileVersionMSh As Integer
   dwFileVersionLSl As Integer
   dwFileVersionLSh As Integer
   dwProductVersionMSl As Integer
   dwProductVersionMSh As Integer
   dwProductVersionLSl As Integer
   dwProductVersionLSh As Integer
   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 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 GetFileVersionInfoSize _
  Lib "Version.dll" _
  Alias "GetFileVersionInfoSizeA" _
  (ByVal lptstrFilename As String, _
   lpdwHandle As Long) _
  As Long

Private Declare Function VerQueryValue _
  Lib "Version.dll" _
  Alias "VerQueryValueA" _
  (pBlock As Any, _
   ByVal lpSubBlock As String, _
   lplpBuffer As Any, _
   puLen As Long) _
  As Long

Private Declare Sub MoveMemory _
  Lib "kernel32" _
  Alias "RtlMoveMemory" _
  (dest As Any, _
   ByVal Source As Long, _
   ByVal length As Long)

Private Sub GetResourceVersion( _
  strFileName As String, _
  recFileVer As FileVersion)
  ' Comments  : Returns file version information
  ' Parameters: strFileName - Name of the file
  '             recFileVer - FILEVERSION type
  ' Returns   : Nothing
  '
  Dim lngRC As Long
  Dim lngDummy As Long
  Dim abytBuffer() As Byte
  Dim lngBufferLen As Long
  Dim lngVerPointer As Long
  Dim udtVerBuffer As VS_FIXEDFILEINFO
  Dim lngVerbufferLen As Long
  
  On Error GoTo PROC_ERR
  
  ' Get the size
  lngBufferLen = GetFileVersionInfoSize(strFileName, lngDummy)
  If lngBufferLen < 1 Then
     Exit Sub
  End If

  ' Set up the byte array
  ReDim abytBuffer(lngBufferLen)
  
  ' Get the file version information
  lngRC = GetFileVersionInfo(strFileName, 0&, lngBufferLen, abytBuffer(0))
  lngRC = VerQueryValue(abytBuffer(0), "\", lngVerPointer, lngVerbufferLen)
  
  ' Manipulate the bits
  MoveMemory udtVerBuffer, lngVerPointer, Len(udtVerBuffer)

  ' Build the file version string
  recFileVer.FileVersion = _
    Format$(udtVerBuffer.dwFileVersionMSh) & "." & _
    Format$(udtVerBuffer.dwFileVersionMSl) & "." & _
    Format$(udtVerBuffer.dwFileVersionLSh) & "." & _
    Format$(udtVerBuffer.dwFileVersionLSl)
                            
  recFileVer.FileVersionLSh = udtVerBuffer.dwFileVersionLSh
  recFileVer.FileVersionLSl = udtVerBuffer.dwFileVersionLSl
  recFileVer.FileVersionMSh = udtVerBuffer.dwFileVersionMSh
  recFileVer.FileVersionMSl = udtVerBuffer.dwFileVersionMSl
  
  ' Build the product version string
  recFileVer.ProductVersion = _
    Format$(udtVerBuffer.dwProductVersionMSh) & "." & _
    Format$(udtVerBuffer.dwProductVersionMSl) & "." & _
    Format$(udtVerBuffer.dwProductVersionLSh) & "." & _
    Format$(udtVerBuffer.dwProductVersionLSl)
        
  recFileVer.ProductVersionLSh = udtVerBuffer.dwProductVersionLSh
  recFileVer.ProductVersionLSl = udtVerBuffer.dwProductVersionLSl
  recFileVer.ProductVersionMSh = udtVerBuffer.dwProductVersionMSh
  recFileVer.ProductVersionMSl = udtVerBuffer.dwProductVersionMSl
  
PROC_EXIT:
  Exit Sub
  
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "GetResourceVersion"
  Resume PROC_EXIT
  
End Sub

Public Function IsOLELibNewer() As Boolean
  ' Comments  : Determines if the installed OLE Automation library
  '             (OLEAUT32.DLL) has the sliding window algorithm
  '             in place.
  ' Parameters: None
  ' Returns   : True if the newer version supporting the sliding
  '             window algorithm is installed, False otherwise or
  '             if an internal error occurs.
  '
  Dim strFile As String
  Dim recFile As FileVersion
  
  On Error GoTo PROC_ERR
  
  strFile = "OLEAUT32.DLL"
  
  GetResourceVersion strFile, recFile
  
  Select Case recFile.FileVersionLSh
    Case 0
      ' Old version
      IsOLELibNewer = False
    Case 4044
      ' Old algoritm
      IsOLELibNewer = False
    Case Is >= 4049
      ' New algorithm
      IsOLELibNewer = True
    Case Else
      ' Some unknown version, assume failure
      MsgBox "Unknown OLEAUT32.DLL version."
      IsOLELibNewer = False
      
  End Select
  
PROC_EXIT:
  Exit Function
  
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "IsOLELibNewer"
  Resume PROC_EXIT
  
End Function