[RESOLVED] File Type Association

Well, I now how to add the association to the registry, but I am having trouble with the ShellNew key. I have attatched my code for anybody to look at.
Sorry About the Length...

Code:

---

Public Function File_Command(Extension As String, Action As String, Command As String)
   
    Dim lRtn    As Long    ' API Return Code
    Dim hKey    As Long    ' Handle Of Open Key
    Dim lCdata  As Long    ' The Data
    Dim lValue  As Long    ' Long (DWORD) Value
    Dim sValue  As String  ' String Value
    Dim lRtype  As Long    ' Type Returned String Or DWORD
    Dim KeyName As String
    Dim lsize As Long

    ' Open The Registry Key.
    lRtn = RegOpenKeyEx(HKEY_CLASSES_ROOT, Extension, 0&, KEY_ALL_ACCESS, hKey)
 
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox OpenErr
        RegCloseKey (hKey)
        Exit Function
    End If
 
    ' Query Registry Key For Value Type.
    lRtn = RegQueryValueExNULL(hKey, "", 0&, lRtype, 0&, lCdata)
 
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox QueryErr
        RegCloseKey (hKey)
        Exit Function
    End If
 
    sValue = String(lCdata, 0)
    ' Get Registry String Value.
    lRtn = RegQueryValueExString(hKey, "", 0&, lRtype, sValue, lCdata)
   
    ' Close The Registry Key.
    RegCloseKey (hKey)
 
    'MsgBox (sValue)
    sValue = Left$(sValue, (Len(sValue) - 1))
 
    'RegCloseKey (hKey)
    KeyName = sValue + "\shell\" + Action
    'MsgBox (KeyName)
   
    ' Create The New Registry Key.
    lRtn = RegCreateKeyEx(HKEY_CLASSES_ROOT, KeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
                          KEY_ALL_ACCESS, 0&, hKey, lRtn)
 
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox CreateErr
    End If
 
    sValue = Action          ' Assign Key Value
    lsize = Len(sValue)      ' Get Size Of String
    ' Set String Value.
    lRtn = RegSetValueExString(hKey, "", 0&, REG_SZ, sValue, lsize)
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox "Error Setting String Value!"
        RegCloseKey (hKey)
        Exit Function
    End If

    ' Close The Registry Key.
    RegCloseKey (hKey)
 
    KeyName = KeyName + "\command"
   
    ' Create The New Registry Key.
    lRtn = RegCreateKeyEx(HKEY_CLASSES_ROOT, KeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
                          KEY_ALL_ACCESS, 0&, hKey, lRtn)
 
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox CreateErr
    End If
 
    sValue = Command        ' Assign Key Value
    lsize = Len(sValue)      ' Get Size Of String
    ' Set String Value.
    lRtn = RegSetValueExString(hKey, "", 0&, REG_SZ, sValue, lsize)
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox "Error Setting String Value!"
        RegCloseKey (hKey)
        Exit Function
    End If

    ' Close The Registry Key.
    RegCloseKey (hKey)
   
End Function

Public Function Associate_File(Extension As String, Application As String, Identifier As String, Description As String, Icon As String)

    Dim lRtn    As Long    ' Returned Value From API Registry Call
    Dim hKey    As Long    ' Handle Of Open Key
    Dim lValue  As Long    ' Setting A Long Data Value
    Dim sValue  As String  ' Setting A String Data Value
    Dim lsize  As Long    ' Size Of String Data To Set
    Dim commandline As String
 

    ' Create The New Registry Key, the file extension
    lRtn = RegCreateKeyEx(HKEY_CLASSES_ROOT, Extension, 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
                          KEY_ALL_ACCESS, 0&, hKey, lRtn)
 
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox CreateErr
    End If
     
    lsize = Len(Identifier)      ' Get Size Of identifier String
    ' Set "(Default)" String Value to identifier
    lRtn = RegSetValueExString(hKey, "", 0&, REG_SZ, Identifier, lsize)
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox "Error Setting String Value!"
        RegCloseKey (hKey)
        Exit Function
    End If
   
    ' Create The New Registry Key, the default icon key within the identifier key
    lRtn = RegCreateKeyEx(HKEY_CLASSES_ROOT, (Extension + "\ShellNew"), 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
                          KEY_ALL_ACCESS, 0&, hKey, lRtn)
                         
    ' Close The Registry Key.
    RegCloseKey (hKey)
   
    ' Create The New Registry Key, the file extension identifier
    lRtn = RegCreateKeyEx(HKEY_CLASSES_ROOT, (Extension + "\ShellNew"), 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
                          KEY_ALL_ACCESS, 0&, hKey, lRtn)

    ' Close The Registry Key.
    RegCloseKey (hKey)

    ' Create The New Registry Key, the file extension identifier
    lRtn = RegCreateKeyEx(HKEY_CLASSES_ROOT, Identifier, 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
                          KEY_ALL_ACCESS, 0&, hKey, lRtn)
 
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox CreateErr
    End If
 
    lsize = Len(Description)      ' Get Size Of file type description String
    ' Set (Default) String Value to description of the file type
    lRtn = RegSetValueExString(hKey, "", 0&, REG_SZ, Description, lsize)
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox "Error Setting String Value!"
        RegCloseKey (hKey)
        Exit Function
    End If

    ' Close The Registry Key.
    RegCloseKey (hKey)

    ' Create The New Registry Key, the default icon key within the identifier key
    lRtn = RegCreateKeyEx(HKEY_CLASSES_ROOT, (Identifier + "\DefaultIcon"), 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
                          KEY_ALL_ACCESS, 0&, hKey, lRtn)
 
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox CreateErr
    End If
 
    lsize = Len(Icon)      ' Get Size Of String
    ' Set (Default) String Value to the full path name of the icon that will be associated with
    '    this file type
 
    lRtn = RegSetValueExString(hKey, "", 0&, REG_SZ, Icon, lsize)
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox "Error Setting String Value!"
        RegCloseKey (hKey)
        Exit Function
    End If

    ' Close The Registry Key.
    RegCloseKey (hKey)

    ' Create The New Registry Key, the "shell" key within the identifier key
    Identifier = Identifier + "\shell"
    lRtn = RegCreateKeyEx(HKEY_CLASSES_ROOT, Identifier, 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
                          KEY_ALL_ACCESS, 0&, hKey, lRtn)
 
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox CreateErr
    End If
 
    ' Close The Registry Key.
    RegCloseKey (hKey)

    ' Create The New Registry Key, the "open" command key within the shell key
    Identifier = Identifier + "\open"

    lRtn = RegCreateKeyEx(HKEY_CLASSES_ROOT, Identifier, 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
                          KEY_ALL_ACCESS, 0&, hKey, lRtn)
 
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox CreateErr
    End If
 
    ' Close The Registry Key.
    RegCloseKey (hKey)

    ' Create The New Registry Key, the "command"  key within the "open" command key
    Identifier = Identifier + "\command"
   
    lRtn = RegCreateKeyEx(HKEY_CLASSES_ROOT, Identifier, 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
                          KEY_ALL_ACCESS, 0&, hKey, lRtn)
 
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox CreateErr
    End If

    commandline = (Chr$(34) + Application + Chr$(34) + " " + Chr$(34) + "%1" + Chr$(34))
    lsize = Len(commandline)      ' Get Size Of String
    ' Set (Default) String Value of the "command" key to the command line to be used to open the file
    lRtn = RegSetValueExString(hKey, "", 0&, REG_SZ, commandline, lsize)
    ' Check For An Error.
    If lRtn <> ERROR_SUCCESS Then
        MsgBox "Error Setting String Value!"
        RegCloseKey (hKey)
        Exit Function
    End If

    ' Close The Registry Key.
    RegCloseKey (hKey)
End Function

Public Sub CreateShellNew()
    Open "C:\WINDOWS\SHELLNEW\SampleFile.spl" For Output As #1
    Print #1, "VBNetDude"
    Close #1
End Sub

---

Quote:

---

' Create The New Registry Key, the default icon key within the identifier key
lRtn = RegCreateKeyEx(HKEY_CLASSES_ROOT, (Extension + "\ShellNew"), 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, 0&, hKey, lRtn)

' Close The Registry Key.
RegCloseKey (hKey)

' Create The New Registry Key, the file extension identifier
lRtn = RegCreateKeyEx(HKEY_CLASSES_ROOT, (Extension + "\ShellNew"), 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, 0&, hKey, lRtn)

' Close The Registry Key.
RegCloseKey (hKey)

---

which time gives the problem?
what is the error message?

My trouble is that the code doesn't work. I right-mouse-click on the desktop and point to "New"... I cannot find my file in there. So, it doesn't give an error, but the code just doesn't work. Sorry about being vague...

As for the duplicate, I was trying something, copied that line, and played with it. I got an error, so I just changed it back to the original. I didn't delete it because I wanted to know where that place was.

are you creating a nullfile string value, with nullstring?

For Association I've always used this code by Aaron Young without any problems:

http://www.vbforums.com/showthread.php?t=241188

Hey, Thanks! I might use that. It is a bit smaller than mine... but it doesn't allow me to right mouse click and create a new file with my extention...

Code:

---

are you creating a nullfile string value, with nullstring?

---

I am not sure how to do that, and am hesitant to fiddle with my code because it edit the registry... how would that be done?

if there is no values then the shell new will not work, it needs either a nullfile value, or filename, with path to template for new file

for further information see
http://windowsxp.mvps.org/shellnewadd.htm

there are plenty of examples to use registry APIs in codebank, do a search

Thank you for your guys' help!