by Waty Thierry (60 Submissions)
Category: Registry
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Tue 30th March 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Create file association
API Declarations
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : [email protected]
' * Date : 26/11/98
' * Time : 15:33
' * Module Name : FileAssociation_Module
' * Module Filename : FileAssociation.bas
' **********************************************************************
' * Comments : Create file association
' *
' *
' **********************************************************************
Option Explicit
Private Const REG_SZ As Long = 1
Private Const REG_DWORD As Long = 4
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const ERROR_NONE = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_INVALID_PARAMETER = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259
Private Const KEY_ALL_ACCESS = &H3F
Private Const REG_OPTION_NON_VOLATILE = 0
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" 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.dll" 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 RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
VBcoders
' #VBIDEUtils#************************************************************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : [email protected]
' * Date : 26/11/98
' * Time : 15:32
' * Module Name : FileAssociation_Module
' * Module Filename : FileAssociation.bas
' * Procedure Name : CreateAssociation
' * Parameters :
' * sExtension As String
' * sAppName As String
' * sFilePath As String
' **********************************************************************
' * Comments : Create a file assosiation
' *
' *
' **********************************************************************
Dim sPath As String
'File Associations begin with a listing
'of the default extension under HKEY_CLASSES_ROOT.
'So the first step is to create that
'root extension item
CreateNewKey "." & sExtension, HKEY_CLASSES_ROOT
'To the extension just added, add a
'subitem where the registry will look for
'commands relating to the .xxx extension
'("MyApp.Document"). Its type is String (REG_SZ)
SetKeyValue "." & sExtension, "", sAppName & ".Document", REG_SZ
'Create the 'MyApp.Document' item under
'HKEY_CLASSES_ROOT. This is where you'll put
'the command line to execute or other shell
'statements necessary.
CreateNewKey sAppName & ".Document\shell\open\command", HKEY_CLASSES_ROOT
'Set its default item to "MyApp Document".
'This is what is displayed in Explorer against
'for files with a xxx extension. Its type is
'String (REG_SZ)
SetKeyValue sAppName & ".Document", "", sAppName & " Document", REG_SZ
'Finally, add the path to myapp.exe
'Remember to add %1 as the final command
'parameter to assure the app opens the passed
'command line item.
'(results in '"c:\LongPathname\Myapp.exe %1")
'Again, its type is string.
sPath = sFilePath & " %1"
SetKeyValue sAppName & ".Document\shell\open\command", "", sPath, REG_SZ
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 = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
nValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, nValue, 4)
End Select
End Function
Private Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
'handle to the new key
Dim hKey As Long
'result of the RegCreateKeyEx function
Dim r As Long
r = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hKey, r)
Call RegCloseKey(hKey)
End Sub
Private Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
'result of the SetValueEx function
Dim r As Long
'handle of opened key
Dim hKey As Long
'open the specified key
r = RegOpenKeyEx(HKEY_CLASSES_ROOT, sKeyName, 0, KEY_ALL_ACCESS, hKey)
r = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
Call RegCloseKey(hKey)
End Sub
