[VB] Associare ad estensione, come ?

[DanieleC88]

Come faccio ad associare un programma all'estensione che voglio io ?

[xegallo]

Public Type mnuCommands
    Captions As New Collection
    Commands As New Collection
End Type
Public Type filetype
    Commands As mnuCommands
    Extension As String
    ProperName As String
    FullName As String
    ContentType As String
    IconPath As String
    IconIndex As Integer
End Type
Public Const REG_SZ = 1
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Declare Function RegCloseKey Lib "advapi32.dll" _
    (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32" _
    Alias "RegCreateKeyA" (ByVal hKey As Long, _
    ByVal lpszSubKey As String, phkResult As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32" _
    Alias "RegSetValueExA" (ByVal hKey As Long, _
    ByVal lpszValueName As String, _
    ByVal dwReserved As Long, ByVal fdwType As Long, _
    lpbData As Any, ByVal cbData As Long) As Long
'Codice del modulo:
'Aggiungi il seguente codice ad un modulo
Public Sub CreateExtension(newfiletype As filetype)
    Dim IconString As String
    Dim Result As Long, Result2 As Long, ResultX As Long
    Dim ReturnValue As Long, HKeyX As Long
    Dim cmdloop As Integer
    IconString = newfiletype.IconPath & "," & newfiletype.IconIndex
    If Left$(newfiletype.Extension, 1) <> "." Then newfiletype.Extension = "." & newfiletype.Extension
    RegCreateKey HKEY_CLASSES_ROOT, newfiletype.Extension,Result
    ReturnValue = RegSetValueEx(Result, "", 0, REG_SZ, ByVal newfiletype.ProperName, LenB(StrConv(newfiletype.ProperName, vbFromUnicode)))
    ' Imposta il tipo di contenuto
    If newfiletype.ContentType <> "" Then
        ReturnValue = RegSetValueEx(Result, "Content Type", 0, REG_SZ, ByVal CStr(newfiletype.ContentType), LenB(StrConv(newfiletype.ContentType, vbFromUnicode)))
    End If
    RegCreateKey HKEY_CLASSES_ROOT, newfiletype.ProperName, Result
    If Not IconString = ",0" Then
        RegCreateKey Result, "DefaultIcon", Result2 'Create The Key of "ProperName\DefaultIcon"
        ReturnValue = RegSetValueEx(Result2, "", 0, REG_SZ, ByVal IconString, LenB(StrConv(IconString, vbFromUnicode)))
        ' Imposta il valore predefinito per la chiave
    End If
    ReturnValue = RegSetValueEx(Result, "", 0, REG_SZ, ByVal newfiletype.FullName, LenB(StrConv(newfiletype.FullName, vbFromUnicode)))
    RegCreateKey Result, ByVal "Shell", ResultX
    ' Crea le sottochiavi necessarie per ogni comando
    For cmdloop = 1 To newfiletype.Commands.Captions.Count
        RegCreateKey ResultX, ByVal newfiletype.Commands.Captions(cmdloop), Result
        RegCreateKey Result, ByVal "Command", Result2
        Dim CurrentCommand$
        CurrentCommand = newfiletype.Commands.Commands(cmdloop)
        ReturnValue = RegSetValueEx(Result2, "", 0, REG_SZ, ByVal CurrentCommand$, LenB(StrConv(CurrentCommand$, vbFromUnicode)))
        RegCloseKey Result
        RegCloseKey Result2
    Next
    RegCloseKey Result2
End Sub

'Codice
'Poi usa questo codice per creare associazioni:
Dim myfiletype As filetype
myfiletype.ProperName = "MioFile"
myfiletype.FullName = "Mio Tipo di File"
myfiletype.ContentType = "Tipo MIME"
myfiletype.Extension = ".IMF"
myfiletype.Commands.Captions.Add "Apri"
myfiletype.Commands.Commands.Add "c:\windows\notepad.exe ""%1"""
myfiletype.Commands.Captions.Add "Stampa"
myfiletype.Commands.Commands.Add "c:\windows\notepad.exe ""%1"" /P"
CreateExtension myfiletype

[DanieleC88]

Grazie !