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