main page >programming tips (VB5/6) >  Associate a file type     diese Seite auf deutsch diese Seite auf deutsch
 
Whenever you double-click a file in Windows Explorer, it will be opened with the associated application as long as the file type is registered. For instance, the extension .txt is registered with notepad.exe by default; that is, a double click on the file c:\test.txt calls notepad.exe with the path of the selected file as parameter, just as if you had entered this into the command line: nodepad.exe c:\test.txt. The called application is then expected to read the parameter (VB has the Command$() function for this) and handle it appropriately.

The following routine shows how to register a file type programmatically using VB. Not only does it handle the registration itself, but also
  1. the icon of the application is registered as the icon that shows up with the file type in Explorer and
  2. the system gets informed about the changes, so the file type will be displayed with the icon in Explorer immediately.

'API declares; copy this to a standard module

Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
  (ByVal HKEY As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" _
  (ByVal HKEY As Long, ByVal lpSubKey As String, ByVal dwType As Long, _
  ByVal lpData As String, ByVal cbData As Long) As Long

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal HKEY As Long) As Long

Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
  (ByVal HKEY As Long, ByVal lpSubKey As String) As Long

Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
  (ByVal HKEY As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
  (ByVal HKEY As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
  ByVal samDesired As Long, phkResult As Long) As Long

Declare Sub SHChangeNotify Lib "Shell32.dll" (ByVal wEventId&, ByVal uFlags&, _
  ByVal dwItem1 As Any, ByVal dwItem2 As Any)

Declare Function FindExecutable Lib "Shell32.dll" Alias _
  "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, _
  ByVal lpResult As String) As Long

Const HKEY_CLASSES_ROOT As Long = &H80000000
Const REG_SZ As Long = 1
Const SHCNE_ASSOCCHANGED As Long = &H8000000
            


'Associate a file type

Function AssocFileType(ByVal Extension As String, _
                       ByVal Identifier As String, _
                       ByVal Description As String, _
                       ByVal ApplicationPath As String) As Boolean

'*** parameter:
' Extension:        extension to be associated, e.g. "TXT" / ".TXT"
' Identifier:       unique identifier of the file type, e.g. "txtfile"
' Description:      description of the file type, e.g. "text file"
' ApplicationPath:  complete path to your application

Dim lphKey As Long, l As Long, s As String

If Left$(Extension, 1) <> "." Then
  Extension = "." & Extension
End If

If RegCreateKey(HKEY_CLASSES_ROOT, Extension, lphKey) = 0 Then
  If lphKey Then
    If RegSetValue(lphKey, "", REG_SZ, Identifier, 0&) = 0 Then
      l = RegCloseKey(lphKey)
      l = RegCreateKey(HKEY_CLASSES_ROOT, Identifier, lphKey)
      l = RegSetValue(lphKey, "", REG_SZ, Description, 0&)
      s = ApplicationPath & " ""%1"""
      l = RegSetValue(lphKey, "shell\open\command", REG_SZ, s, Len(s))
      s = ""
      l = RegSetValue(lphKey, "shell", REG_SZ, s, Len(s))
      s = ApplicationPath & ",0"
      l = RegSetValue(lphKey, "DefaultIcon", REG_SZ, s, Len(s))
      SHChangeNotify SHCNE_ASSOCCHANGED, 0&, 0&, 0&
      AssocFileType = True 'finished successfully
    End If
    l = RegCloseKey(lphKey)
  End If
End If
End Function
            
The function returns True if successful; please note that sufficient write permissions for the HKEY_CLASSES_ROOT registry branch are required.

Your application should be aware that the file name retrieved from Command$() will be enclosed in quotes, and remove them before continuing:

Sub Main()
Dim s As String
s = Command$()
If Len(s) > 2 Then
  If Left$(s, 1) = """" Then
    If Right$(s, 1) = """" Then
    s = Mid$(s, 2, Len(s) - 2)
    End If
  End If
End If

If Len(s) Then
  If FileExists(s) Then
  Open ...
  End If
End If
End Sub

            
Before you associate a file type with your application, you should check whether the extension is already registered with a different application:

Public Function AppForFile(ByVal Filename As String) As String
'find the program associated with an existing (!) file
Dim Path As String
Const MAX_PATH& = 256
Path = Space$(MAX_PATH)
FindExecutable Filename, vbNullString, Path
AppForFile = Left$(Path, InStr(Path, vbNullChar) - 1)
End Function
            
If so, it is strongly recommended to ask the user if he allows your application to take over this registration.

  If LenB(AppForFile("MyFile.mfl")) = 0 Then
    AssocFileType ".mfl", "mflfile", "file for my program", App.Path & "\" & App.ExeName & ".exe"
  End If
            
Last but not least, here comes a routine to undo a file type registration:


'Deassociate a file type

Function DeAssocFileType(ByVal Extension As String) As Boolean

'*** parameters:
' Extension: extension to be de-registered, e.g. "TXT" / ".TXT"

Dim l As Long, lphKey As Long, lType As Long, lBufLen As Long
Dim sKeyName As String, sKeyValue As String, b() As Byte

  If Left$(Extension, 1) <> "." Then
    Extension = "." & Extension
  End If

  If RegOpenKeyEx(HKEY_CLASSES_ROOT, Extension, 0&, KEY_ALL_ACCESS, lphKey) = 0 Then
    l = RegQueryValueEx(lphKey, "", 0&, lType, 0&, lBufLen)
    If l = 0 And lType = REG_SZ Then
      ReDim b(0 To lBufLen - 1)
      l = RegQueryValueEx(lphKey, "", 0&, lType, VarPtr(b(0)), lBufLen)
      sKeyValue = Left$(StrConv(b, vbUnicode), lBufLen - 1)
    Else
      RegCloseKey lphKey
      Exit Function
    End If
    RegCloseKey lphKey
    l = RegDeleteKey(HKEY_CLASSES_ROOT, Extension)
    If RegDeleteKey(HKEY_CLASSES_ROOT, sKeyValue & "\shell\open\command") = 0 Then
      If RegDeleteKey(HKEY_CLASSES_ROOT, sKeyValue & "\shell\open") = 0 Then
        RegDeleteKey HKEY_CLASSES_ROOT, sKeyValue & "\shell"
      End If
    End If

    If RegDeleteKey(HKEY_CLASSES_ROOT, sKeyValue & "\DefaultIcon") = 0 Then
      RegDeleteKey HKEY_CLASSES_ROOT, sKeyValue
    End If
    SHChangeNotify SHCNE_ASSOCCHANGED, 0&, 0&, 0&
    DeAssocFileType = True 'finished successfully
  End If
End Function

            
main page >  programming tips (VB5/6) >  this page