Private Type VS_FIXEDFILEINFO
   dwSignature As Long
   dwStrucVersion As Long     'e.g. 0x00000042 = "0.42"
   dwFileVersionMS As Long    'e.g. 0x00030075 = "3.75"
   dwFileVersionLS As Long    'e.g. 0x00000031 = "0.31"
   dwProductVersionMS As Long 'e.g. 0x00030010 = "3.10"
   dwProductVersionLS As Long 'e.g. 0x00000031 = "0.31"
   dwFileFlagsMask As Long    'e.g. 0x3F for version "0.42"
   dwFileFlags As Long        'e.g. VFF_DEBUG Or VFF_PRERELEASE
   dwFileOS As Long           'e.g. VOS_DOS_WINDOWS16
   dwFileType As Long         'e.g. VFT_DRIVER
   dwFileSubtype As Long      'e.g. VFT2_DRV_KEYBOARD
   dwFileDateMS As Long       'e.g. 0
   dwFileDateLS As Long       'e.g. 0
End Type

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, _
   lplpBuffer 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 Const MAXDWORD As Long = &HFFFFFFFF
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10

Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Private Type FILE_PARAMS  'my custom type for passing info
   bRecurse As Boolean   'var not used in this demo
   bList As Boolean
   bFound As Boolean     'var not used in this demo
   sFileRoot As String
   sFileNameExt As String
   sResult As String     'var not used in this demo
   nFileCount As Long    'var not used in this demo
   nFileSize As Double   'var not used in this demo
End Type

Private Declare Function FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long
   
Private Declare Function FindFirstFile Lib "kernel32" _
   Alias "FindFirstFileA" _
  (ByVal lpFileName As String, _
   lpFindFileData As WIN32_FIND_DATA) As Long
   
Private Declare Function FindNextFile Lib "kernel32" _
   Alias "FindNextFileA" _
  (ByVal hFindFile As Long, _
   lpFindFileData As WIN32_FIND_DATA) 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 Form_Load()

   With Combo1
      .AddItem "*.*"
      .AddItem "*.dll"
      .AddItem "*.exe"
      .AddItem "*.ini"
      .AddItem "*.ocx"
      .AddItem "*.vxd"
      .ListIndex = 2
   End With
   
End Sub


Private Sub Command1_Click()

   Dim FP As FILE_PARAMS
    
   ListView1.ListItems.Clear
   
   With FP
      .sFileRoot = Text1.Text
      .sFileNameExt = Combo1.Text
      .bRecurse = Check1.Value = 1
      .bList = True
   End With
   
   Call SearchForFiles(FP)

End Sub
  

Private Function SearchForFiles(FP As FILE_PARAMS) As Double

   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
   Dim nSize As Long
   Dim sPath As String
   Dim sRoot As String
   Dim sTmp As String
      
   sRoot = QualifyPath(FP.sFileRoot)
   sPath = sRoot & "*.*"
   
  'obtain handle to the first match
   hFile = FindFirstFile(sPath, WFD)
   
  'if valid ...
   If hFile <> INVALID_HANDLE_VALUE Then
   
     'This is where the method obtains the file
     'list and data for the folder passed.
     '
     'GetFileInformation function returns the size,
     'in bytes, of the files found matching the
     'filespec in the passed folder, so its
     'assigned to nSize. It is not directly assigned
     'to FP.nFileSize because nSize is incremented
     'below if a recursive search was specified.
      nSize = GetFileInformation(FP)
      FP.nFileSize = nSize

      Do
      
        'if the returned item is a folder...
         If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
            
           '..and the Recurse flag was specified
            If FP.bRecurse Then
            
              'remove trailing nulls
               sTmp = TrimNull(WFD.cFileName)
               
              'and if the folder is not the default
              'self and parent folders...
               If sTmp <> "." And sTmp <> ".." Then
               
                 '..then the item is a real folder, which
                 'may contain other sub folders, so assign
                 'the new folder name to FP.sFileRoot and
                 'recursively call this function again with
                 'the amended information.
                 '
                 'Since nSize is a local variable whose value
                 'is both set above as well as returned as the
                 'function call value, nSize needs to be added 
                 'to previous calls in order to maintain accuracy.
                 '
                 'However, because the nFileSize member of
                 'FILE_PARAMS is passed back and forth through
                 'the calls, nSize is simply assigned to it
                 'after the recursive call finishes.
                  FP.sFileRoot = sRoot & sTmp
                  nSize = nSize + SearchForFiles(FP)
                  FP.nFileSize = nSize
                  
               End If
               
            End If
            
         End If
         
     'continue looping until FindNextFile returns
     '0 (no more matches)
      Loop While FindNextFile(hFile, WFD)
      
     'close the find handle
      hFile = FindClose(hFile)
   
   End If
   
  'because this routine is recursive, return
  'the size of matching files
   SearchForFiles = nSize
   
End Function


Private Function GetFileInformation(FP As FILE_PARAMS) As Long

   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
   Dim nSize As Long
   Dim sPath As String
   Dim sRoot As String
   Dim sTmp As String
   Dim itmx As ListItem
      
  'FP.sFileRoot (assigned to sRoot) contains
  'the path to search.
  '
  'FP.sFileNameExt (assigned to sPath) contains
  'the full path and filespec.
   sRoot = QualifyPath(FP.sFileRoot)
   sPath = sRoot & FP.sFileNameExt
   
  'obtain handle to the first filespec match
   hFile = FindFirstFile(sPath, WFD)
   
  'if valid ...
   If hFile <> INVALID_HANDLE_VALUE Then

      Do
      
        'remove trailing nulls
         sTmp = TrimNull(WFD.cFileName)
         
        'Even though this routine uses filespecs,
        '*.* is still valid and will cause the search
        'to return folders as well as files, so a
        'check against folders is still required.
         If Not (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _
            = FILE_ATTRIBUTE_DIRECTORY Then
      
           'file found, so increase the file count
            FP.nFileCount = FP.nFileCount + 1
            
           'retrieve the size and assign to nSize to
           'be returned at the end of this function call
            nSize = nSize + (WFD.nFileSizeHigh * (MAXDWORD + 1)) + WFD.nFileSizeLow
            
           'add to the list if the flag indicates
            If FP.bList Then
                             
              'got the data, so add it to the listview
               Set itmx = ListView1.ListItems.Add(, , LCase$(sTmp))
               
               itmx.SubItems(1) = GetFileVersion(sRoot & sTmp)
               itmx.SubItems(3) = GetFileSizeStr(WFD.nFileSizeHigh + WFD.nFileSizeLow)
               itmx.SubItems(2) = GetFileDescription(sRoot & sTmp)
               itmx.SubItems(4) = LCase$(sRoot)
               
            End If
         
         End If
         
      Loop While FindNextFile(hFile, WFD)
      
      
     'close the handle
      hFile = FindClose(hFile)
   
   End If
   
  'return the size of files found
   GetFileInformation = nSize

End Function


Private Function GetFileSizeStr(fsize As Long) As String

    GetFileSizeStr = Format$((fsize), "###,###,###")   '& " kb"
  
End Function


Private Function QualifyPath(sPath As String) As String

  'assures that a passed path ends in a slash
  
   If Right$(sPath, 1) <> "\" Then
      QualifyPath = sPath & "\"
   Else 
      QualifyPath = sPath
   End If
      
End Function


Public Function TrimNull(startstr As String) As String

  'returns the string up to the first
  'null, if present, or the passed string
   
   Dim pos As Integer
   
   pos = InStr(startstr, Chr$(0))
   
   If pos Then
      TrimNull = Left$(startstr, pos - 1)
      Exit Function
   End If
  
   TrimNull = startstr
  
End Function


Private Function HiWord(dw As Long) As Long
  
   If dw And &H80000000 Then
      HiWord = (dw \ 65535) - 1
   Else
      HiWord = dw \ 65535
   End If
    
End Function
  

Private Function LoWord(dw As Long) As Long
  
   If dw And &H8000& Then
      LoWord = &H8000& Or (dw And &H7FFF&)
   Else
      LoWord = dw And &HFFFF&
   End If
    
End Function


Private Function GetFileDescription(sSourceFile As String) 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
   
   If Len(sSourceFile) > 0 Then

     'set file that has the encryption level
     'info and call to get required size
      nBufferSize = GetFileVersionInfoSize(sSourceFile, nUnused)
      
      ReDim sBuffer(nBufferSize)
      
      If nBufferSize > 0 Then
      
        'get the version info
         Call GetFileVersionInfo(sSourceFile, 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
                     GetFileDescription = GetStrFromPtrA(lpBuffer)

                  End If  'If nVerSize
               End If  'If VerQueryValue
            End If  'If nVerSize
         End If  'If VerQueryValue
      End If  'If nBufferSize
   End If  'If sSourcefile

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 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 GetFileVersion(sDriverFile As String) 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
   
  'GetFileVersionInfoSize determines whether the operating
  'system can obtain version information about a specified
  'file. If version information is available, it returns
  'the size in bytes of that information. As with other
  'file installation functions, GetFileVersionInfoSize
  'works only with Win32 file images.
  '
  'A empty variable must be passed as the second
  'parameter, which the call returns 0 in.
   nBufferSize = GetFileVersionInfoSize(sDriverFile, nUnused)
   
   If nBufferSize > 0 Then
   
     'create a buffer to receive file-version
     '(FI) information.
      ReDim sBuffer(nBufferSize)
      Call GetFileVersionInfo(sDriverFile, 0&, nBufferSize, sBuffer(0))
      
     'VerQueryValue function returns selected version info
     'from the specified version-information resource. Grab
     'the file info and copy it into the  VS_FIXEDFILEINFO structure.
      Call VerQueryValue(sBuffer(0), "\", lpBuffer, nVerSize)
      Call CopyMemory(FI, ByVal lpBuffer, Len(FI))
     
     'extract the file version from the FI structure
      tmpVer = Format$(HiWord(FI.dwFileVersionMS)) & "." & _
               Format$(LoWord(FI.dwFileVersionMS), "00") & "."
         
      If FI.dwFileVersionLS > 0 Then
         tmpVer = tmpVer & Format$(HiWord(FI.dwFileVersionLS), "00") & "." & _
                           Format$(LoWord(FI.dwFileVersionLS), "00")
      Else
         tmpVer = tmpVer & Format$(FI.dwFileVersionLS, "0000")
      End If
      
      End If
   
   GetFileVersion = tmpVer
   
End Function