'
' =============================================================================
' FileAssociation.Txt            April 2004                 by Jacques PHILIPPE
'
'             Association of an Executable to a File Extension
' Function                                                   Version 0.0.1 beta
' =============================================================================
'        *****  WITH NO WARRANTY. USE AT YOUR OWN RISK. I USE IT  *****
' =============================================================================
'
' Function SetFileAssociation (FileExtension As String, Command As String) As Long
' --------
'       - FileExtension : the file extension with its dot to be associated with the
'                         command : IE  ".Bas". Maximum 4 characters + the dot.
'       - Command : the path of the application to execute for that file extension
'                   add " %1" if the file must be passed to the application as a command line
'                   argument (always add %1).
'       - returned values : 0 on failure, argument missing or more than 5 characters with dot,
'                           1 on OK
'
'    Simply set a new file association. The old one is overwritten.
'
'    Example :
'    -------
'    $Include ("FileAssociation.Inc")
'    iError = SetFileAssociation (".Bas", "c:\Windows\Notepad.Exe %1")
' =============================================================================
'
Const SFAF_HKEY_CLASSES_ROOT = &H80000000
Function SetFileAssociation (sFileExtension As String, sCommand As String) As Long
    DefStr sDescriptor, sFileExt
    Dim regFA AS QRegistry
  With regFA
    .RootKey = SFAF_HKEY_CLASSES_ROOT
    ' Check If File Extension is not Empty
    If sFileExtension = "" Then
        Result = 0
        Exit Function
    End If
    ' Check that there is a DOT most left ".Bas" and not "Bas", if missing, I add it.
    If Left$(sFileExtension, 1) <> "." Then
        sFileExt = "." & sFileExtension
    Else
        sFileExt = sFileEXtension
    End If
    ' Maximum four characters plus the dot "."
    If Len(sFileExt) > 5 Then
        Result = 0
        Exit Function
    End If
    sDescriptor = (sFileExt - ".") & "_File"
    If .KeyExists (sDescriptor) Then          ' Delete Old Association Datas if exist
        .DeleteKey (sDescriptor)
        DoEvents
    End If
    .OpenKey (sFileExt, 1)                    ' Write/Overwrite new descriptor
        .WriteString ("", sDescriptor)
    .CloseKey
    .OpenKey(sDescriptor & "\\Shell\\Open\\Command", 1) ' Create Key shell\Open\Command
        .WriteString ("", sCommand)           ' Writes the command to execute
    .CloseKey
  End With
    Result = 1
End Function
'