Wenn Sie im Windows-Explorer eine Datei doppelklicken, wird sie, sofern es sich um einen registrierten Dateityp handelt, mit der zugehörigen Anwendung geöffnet. Beispielsweise ist die Dateiendung .txt standardmässig mit dem Minimal-Editor notepad.exe verknüpft; ein Doppelklick auf eine Datei c:\test.txt führt also zu einem Aufruf von notepad.exe, wobei der Pfad zur gewählten Datei als Kommandozeilenparamter übergeben wird, so als ob Sie folgendes an der Kommandozeile eingegeben hätten: nodepad.exe c:\test.txt. Vom aufgerufenen Programm wird nun erwartet, dass es den Kommandozeilenparameter auswertet (in VB gibt es dafür die Command$()-Funktion) und mit der übergebenen Datei entsprechend verfährt.

Die folgende Routine zeigt, wie Sie eine solche Dateitypen-Registrierung programmatisch mit VB vornehmen können. Sie sorgt nicht nur für die Registrierung an sich, sondern auch dafür, dass

1. das Icon der Anwendung registriert wird als das Icon, mit dem der Dateityp im Explorer dargestellt werden soll und
2. das System über die Änderung informiert wird, so dass der Dateityp sofort mit dem entsprechenden Icon im Explorer dargestellt wird.

'API-Deklarationen; gehören in ein Standard-Modul

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
            

'Funktion zum Assoziieren eines Dateityps

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

'*** Parameter:
' Extension:        Zu assoziierende Erweiterung, z.B. "TXT" / ".TXT"
' Identifier:       Eindeutiger Bezeichner des Dateityps, z.B. "txtfile"
' Description:      Klartext-Beschreibung des Dateityps, z.B. "Textdatei"
' ApplicationPath:  Kompletter Pfad der Anwendung

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 'erfolgreich abgeschlossen
    End If
    l = RegCloseKey(lphKey)
  End If
End If
End Function
            

Die Funktion liefert True zurück, wenn die Operation erfolgreich abgeschlossen wurde; beachten Sie bitte, dass dazu ausreichende Schreibberechtigungen für den Registry-Zweig HKEY_CLASSES_ROOT erforderlich sind.

Ihr Programm sollte berücksichtigen, dass der übergebene Dateiname in Anführungszeichen eingeschlossen übergeben wird, und diese ggfs. entfernen, bevor Sie den Dateinamen weiter verarbeiten:

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

            

Bevor ein Dateityp assoziiert wird, sollte man prüfen, ob der Typ nicht schon einer anderen Anwendung zugeordnet ist:

Public Function AppForFile(ByVal Datei As String) As String
'Ermittelt die mit einer existierenden Datei verknüpfte Programmdatei
Dim Pfad As String
Const MAX_PATH& = 256
Pfad = Space$(MAX_PATH)
FindExecutable Datei, vbNullString, Pfad
AppForFile = Left$(Pfad, InStr(Pfad, vbNullChar) - 1)
End Function
            

wenn ja, ist es guter Stil, wenigstens den Anwender zu fragen, ob das eigene Programm diesen Dateityp übernehmen soll:

  If LenB(AppForFile("MyFile.mfl")) = 0 Then
    AssocFileType ".mfl", "mflfile", "Datei für mein Programm", App.Path & "\" & App.ExeName & ".exe"
  End If
            

Zum Schluss noch eine Routine, mit der sie die Registrierung eines Dateityps wieder rückgängig machen können:

'Funktion zum De-Assoziieren eines Dateityps

Function DeAssocFileType(ByVal Extension As String) As Boolean

'*** Parameter:
' Extension: Erweiterung, deren Assoziation aufgehoben werden soll, z.B. "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 'erfolgreich abgeschlossen
  End If
End Function