2004-04-28 21:00

' =============================================================================
' FileAssociation.Inc            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
'

2004-04-28 21:00