Binaryworld - ListFileExtensions - Retrieve information about all registered file ex ... [ VB -> Windows ]

' List all the File extensions that are registered in the system
'
' return a bi-dimension string array, where
'  arr(0, i) is the file extension
'  arr(1, i) is the coresponding ProgID
'  arr(2, i) is the associated description
'  arr(3, i) is the location of the executable file
'
' Example:
' ' fill a listbox with the descriptions associated
' ' to each registered file extension
' Dim a() As String, i As Long
' a() = ListFileExtensions()
' For i = 1 To UBound(a, 2)
'    List1.AddItem a(0, i) & vbTab & a(2, i)
' Next
'
' NOTE: requires the EnumRegistryKey and GetRegistryValue functions

Function ListFileExtensions() As String()
  Dim regKeys As Collection
  Dim regKey As Variant
  Dim extsNdx As Long
  Dim progID As String
  Dim clsid As String

  Const HKEY_CLASSES_ROOT = &H80000000

  ' retrieve all the subkeys under HKEY_CLASSES_ROOT
  Set regKeys = EnumRegistryKeys(HKEY_CLASSES_ROOT, "")

  ' prepare the array of results
  ReDim exts(3, regKeys.Count) As String

  ' ignore errors
  On Error Resume Next

  For Each regKey In regKeys
    ' check whether this is a File extension
    If Left$(regKey, 1) = "." Then
      ' store the extension in the result array
      extsNdx = extsNdx + 1
      exts(0, extsNdx) = regKey
      ' the default value for this key is the ProgID
      ' or another string that can be searched in the Registry
      progID = GetRegistryValue(HKEY_CLASSES_ROOT, regKey, "")
      exts(1, extsNdx) = progID
      ' the default value of the key HKEY_CLASSES_ROOT\ProgID is
      ' the textual description of this entry
      exts(2, extsNdx) = GetRegistryValue(HKEY_CLASSES_ROOT, progID, "")
      If exts(2, extsNdx) = "" Then
        ' if this key doesn't exist, delete this array entry
        extsNdx = extsNdx - 1
      Else
        ' else try to read the location of the associated EXE file
        exts(3, extsNdx) = GetRegistryValue(HKEY_CLASSES_ROOT, _
          progID & "\shell\open\command", "")
      End If
    End If
  Next

  ' trim unused items
  ReDim Preserve exts(3, extsNdx) As String
  ListFileExtensions = exts()
End Function