[RESOLVED] File Type Association

[VBNetDude]

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...

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

[westconn1]

' 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?

[VBNetDude]

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.

[westconn1]

are you creating a nullfile string value, with nullstring?

[jcis]

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

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

[VBNetDude]

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...

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?

[westconn1]

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

[VBNetDude]

Thank you for your guys' help!