by Joe Dobson (1 Submission)
Category: Registry
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 6th June 2009
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Registers a filename extension, assigns an icon, and a description. When you launch the extension file it opens the application and places the
API Declarations
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3090
ClientLeft = 4845
ClientTop = 3225
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3090
ScaleWidth = 4680
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'****************************************************************
' Register an extension file. Copy this code to your application.
' Set the variables in the form load section as required.
' When you launch the extension file it will open the
' application and place the extension filename on the command line.
'****************************************************************
Private Const REG_SZ As Long = &H1
Private Const REG_DWORD As Long = &H4
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const HKEY_USERS As Long = &H80000003
Private Const ERROR_SUCCESS As Long = 0
Private Const ERROR_BADDB As Long = 1009
Private Const ERROR_BADKEY As Long = 1010
Private Const ERROR_CANTOPEN As Long = 1011
Private Const ERROR_CANTREAD As Long = 1012
Private Const ERROR_CANTWRITE As Long = 1013
Private Const ERROR_OUTOFMEMORY As Long = 14
Private Const ERROR_INVALID_PARAMETER As Long = 87
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const ERROR_MORE_DATA As Long = 234
Private Const ERROR_NO_MORE_ITEMS As Long = 259
Private Const KEY_ALL_ACCESS As Long = &HF003F
Private Const REG_OPTION_NON_VOLATILE As Long = 0
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" _
Alias "RegCreateKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal Reserved As Long, _
ByVal lpClass As String, _
ByVal dwOptions As Long, _
ByVal samDesired As Long, _
ByVal lpSecurityAttributes As Long, _
PhkResult As Long, _
lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" _
Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
PhkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" _
Alias "RegSetValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
lpValue As Any, _
ByVal cbData As Long) As Long
Dim MyApp As String
Dim MyExtension As String
Dim MyIcon As String
Dim MyType As String
Dim MyPath As String
Dim MyDescription As String
VBcoders
Private Sub RegisterExtension()
Dim sPath As String
Dim PhkResult As Long
Dim hKey As Long
CreateNewKey MyExtension, HKEY_CLASSES_ROOT
CreateNewKey MyExtension & "\OpenWithList\" & MyApp & ".exe", HKEY_CLASSES_ROOT
SetKeyValue MyExtension, "", MyType, REG_SZ, HKEY_CLASSES_ROOT
'Set the icon file
CreateNewKey MyExtension & "\DefaultIcon", HKEY_CLASSES_ROOT
SetKeyValue MyExtension & "\DefaultIcon", "", MyIcon, REG_SZ, HKEY_CLASSES_ROOT
CreateNewKey MyApp & ".Settings", HKEY_CLASSES_ROOT
SetKeyValue MyApp & ".Settings", "", MyDescription, REG_SZ, HKEY_CLASSES_ROOT
CreateNewKey MyApp & ".Settings\shell\open\command", HKEY_CLASSES_ROOT
sPath = MyPath & "%1"
SetKeyValue MyApp & ".Settings\shell\open\command", "", sPath, REG_SZ, HKEY_CLASSES_ROOT
End Sub
Private Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim nValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue & Chr$(0)
SetValueEx = RegSetValueEx(hKey, sValueName, 0&, lType, ByVal sValue, Len(sValue))
Case REG_DWORD
nValue = vValue
SetValueEx = RegSetValueEx(hKey, sValueName, 0&, lType, ByVal nValue, 4)
End Select
End Function
Private Sub CreateNewKey(sNewKeyName As String, lpredefinedkey As Long)
'handle to the new key
Dim hKey As Long
Dim result As Long
Call RegCreateKeyEx(lpredefinedkey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hKey, result)
Call RegCloseKey(hKey)
End Sub
Private Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long, lpredefinedkey As Long)
'handle of opened key
Dim hKey As Long
Call RegOpenKeyEx(lpredefinedkey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
Call SetValueEx(hKey, sValueName, lValueType, vValueSetting)
Call RegCloseKey(hKey)
End Sub
Private Sub Form_Load()
Dim Loaded As String
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Set these as required for your application
MyApp = "Commport" 'Name of application exe file
MyExtension = ".cps" 'extension .cps =Comm Port Setting file
MyPath = "c:\program files\commport\commport.exe " 'Path to the application
MyIcon = """C:\program files\commport\net04.ico""" 'Path to the icon
MyType = "CommPort.Settings" 'Type of file
MyDescription = "CommPort Settings File" 'Description
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'check to see if registry settings have already been set
Loaded = GetSetting(MyApp, "Properties", "RegLoaded", "")
If Loaded = "" Then
Call RegisterExtension
'Make a note in registry that extensions have been registered
SaveSetting MyApp, "Properties", "RegLoaded", "TRUE"
If Err Then
MsgBox Error$, 48
Exit Sub
End If
End If
End Sub
No comments have been posted about Registers a filename extension, assigns an icon, and a description. When you launch the extension f. Why not be the first to post a comment about Registers a filename extension, assigns an icon, and a description. When you launch the extension f.
