retrieve file associations

[aafuss]

How would I retrieve and sdisplay the Windows file associations into a listbox?

[j_jewell]

When you say file associations, do you mean get a list of applications on the machine that are designed to open the specific file in question or something else?

[phinds]

don't think this can be done in "native" VB, but via API calls you can do pretty much anything, so I'd suggest you dig into the API docs

[DaveBo]

Here's a link that illustrates how to "create" file associations,
maybe it will help?

http://www.mentalis.org/tips/tip123.shtml

[jim mcnamara]

FindExecutable() gets the assoicated .EXE file, if there is one.
This stuff is also in the registry

This lists the associated file, for one file:

Private Declare Function FindExecutable Lib "shell32" _
   Alias "FindExecutableA" _
  (ByVal lpFile As String, _
   ByVal lpDirectory As String, _
   ByVal sResult As String) As Long

Private Const MAX_PATH As Long = 260
Private Const ERROR_FILE_NO_ASSOCIATION As Long = 31
Private Const ERROR_FILE_NOT_FOUND As Long = 2
Private Const ERROR_PATH_NOT_FOUND As Long = 3
Private Const ERROR_FILE_SUCCESS As Long = 32 'my constant
Private Const ERROR_BAD_FORMAT As Long = 11

Private Sub Command1_Click()

   Dim success As Long
   Dim pos As Long
   Dim sResult As String
   Dim msg As String
   
   sResult = Space$(MAX_PATH)

  'lpFile: name of the file of interest
  'lpDirectory: location of lpFile
  'sResult: path and name of executable associated with lpFile
   success = FindExecutable("winhlp32.hlp", "c:\winnt\system32\", sResult)
      
   Select Case success
      Case ERROR_FILE_NO_ASSOCIATION: msg = "no association"
      Case ERROR_FILE_NOT_FOUND: msg = "file not found"
      Case ERROR_PATH_NOT_FOUND: msg = "path not found"
      Case ERROR_BAD_FORMAT:     msg = "bad format"
      
      Case Is >= ERROR_FILE_SUCCESS:
         
         pos = InStr(sResult, Chr$(0))
         
         If pos Then
            msg = Left$(sResult, pos - 1)
         End If
         
   End Select
   
   MsgBox msg
   
End Sub

This gives you all of the assoications on the system in a ListBox:

Private Const MAX_PATH As Long = 260
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const ERROR_SUCCESS As Long = 0
Private Const vbDot As Long = 46 ' Asc(".") = 46
Private Const SHGFI_USEFILEATTRIBUTES As Long = &H10
Private Const SHGFI_TYPENAME As Long = &H400
Private Const LB_SETTABSTOPS As Long = &H192

Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Private Type SHFILEINFO 
   hIcon As Long
   iIcon As Long
   dwAttributes As Long
   szDisplayName As String * MAX_PATH
   szTypeName As String * 80
End Type

Private Declare Function RegEnumKeyEx Lib "advapi32" _
   Alias "RegEnumKeyExA" _
   (ByVal hKey As Long, _
   ByVal dwIndex As Long, _
   ByVal lpName As String, _
   lpcbName As Long, _
   ByVal lpReserved As Long, _
   ByVal lpClass As String, _
   lpcbClass As Long, _
   lpftLastWriteTime As FILETIME) As Long

Private Declare Function SHGetFileInfo Lib "shell32" _
   Alias "SHGetFileInfoA" _
  (ByVal pszPath As String, _
   ByVal dwFileAttributes As Long, _
   psfi As SHFILEINFO, _
   ByVal cbFileInfo As Long, _
   ByVal uFlags As Long) As Long

Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long


Private Sub Form_Load()

  'Setup tabstops in the listbox by first
  'clearing existing tabs, then setting the
  'new tabstop value.
  
   ReDim TabArray(0) As Long
   
  'only one tabstop
   TabArray(0) = 75
  
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 1&, TabArray(0))
   List1.Refresh
   
   Command1.Caption = "Get Associations"

End Sub


Private Sub Command1_Click()

   List1.Clear
   Me.MousePointer = 11
   
  'fill the listbox box with the
  'file types and their extensions
   Call GetAssociatedFileListing
   
   Me.MousePointer = 0
   
End Sub


Private Sub GetAssociatedFileListing()

   Dim dwIndex As Long
   Dim sTypeName As String
   Dim sSubkey As String * MAX_PATH
   Dim sClass As String * MAX_PATH
   Dim ft As FILETIME
   
   Do While RegEnumKeyEx(HKEY_CLASSES_ROOT, _
                         dwIndex, _
                         sSubkey, _
                         MAX_PATH, _
                         0, sClass, _
                         MAX_PATH, ft) = ERROR_SUCCESS
      
      If Asc(sSubkey) = vbDot Then
         
        'Pass the returned string to get the file type
         sTypeName = GetFileType(sSubkey)
            
         If Len(sTypeName) > 0 Then
            List1.AddItem TrimNull(sSubkey) & vbTab & sTypeName
         End If
            
      End If

      dwIndex = dwIndex + 1
   
   Loop

End Sub


Private Function GetFileType(sFile As String) As String

  'If successful returns the specified file's
  'typename, returns an empty string otherwise.
  'sFile does not have to exist and can be
  'just a file extension.
   Dim sfi As SHFILEINFO

   If SHGetFileInfo(sFile, 0&, _
                    sfi, Len(sfi), _
                    SHGFI_TYPENAME Or SHGFI_USEFILEATTRIBUTES) Then
      GetFileType = TrimNull(sfi.szTypeName)
   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

[dekel]

how do i use the FindExecutable() function?

[manavo11]

http://www.vbforums.com/showthread.p...hreadid=231682