Registry

[Rebis]

Anyone know how to start an application by accessing the registry for its associated file types?

[Chris]

Hi! Rebis, this what I did in the pass few days. May be it can give you some hints..


'Copy this code into a Basic Module file

Option Explicit
'WIN32API Costant
Public Const REG_SZ = 1 ' Unicode nul terminated string
Public Const REG_BINARY = 3 ' Free form binary
Public Const REG_DWORD = 4 ' 32-bit number

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_USERS = &H80000003

Public Const ERROR_SUCCESS = 0&

'WIN32 API declaration
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public 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

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.

Private hCurKey As Long

Public Function DELETE_REG_STRING(ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpString As String) As Long
On Error GoTo ErrHandle
'Data validation
If hKey = 0 Or lpSubKey = "" Or lpString = "" Then GoTo ErrHandle
'Open the given hkey + SubKey
If RegOpenKey(hKey, lpSubKey, hCurKey) = ERROR_SUCCESS Then
'Delete the given String from given hkey + SubKey
If RegDeleteValue(hCurKey, lpString) = ERROR_SUCCESS Then
DELETE_REG_STRING = 1
Else
DELETE_REG_STRING = 0
End If
Else
DELETE_REG_STRING = 0
End If
RegCloseKey hCurKey
Exit Function
ErrHandle:
DELETE_REG_STRING = 0
End Function

Public Function GET_STRING_VALUE(ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpString As String, ByVal dwType As Long) As Variant
On Error GoTo ErrHandle
'Data validation
If hKey = 0 Or lpSubKey = "" Or lpString = "" Then GoTo ErrHandle

'Open the given hkey + subkey
If RegOpenKey(hKey, lpSubKey, hCurKey) = ERROR_SUCCESS Then
'Retrieve the given string value
Select Case dwType
Case REG_SZ
Dim strBuff As String
strBuff = String(255, Chr(0))

If RegQueryValueEx(hCurKey, lpString, 0, dwType, ByVal strBuff, Len(strBuff)) = ERROR_SUCCESS Then
GET_STRING_VALUE = Left(strBuff, InStr(1, strBuff, Chr(0), vbTextCompare))
Else
GET_STRING_VALUE = ""
End If
Case REG_BINARY
Dim strData As Long

If RegQueryValueEx(hCurKey, lpString, 0, dwType, strData, Len(strData)) = ERROR_SUCCESS Then
GET_STRING_VALUE = strData
Else
GET_STRING_VALUE = ""
End If
Case REG_DWORD
Dim strDWORD As String
strDWORD = String(255, Chr(0))

If RegQueryValueEx(hCurKey, lpString, 0, dwType, ByVal strDWORD, Len(strDWORD)) = ERROR_SUCCESS Then
GET_STRING_VALUE = Left(strDWORD, InStr(1, strDWORD, Chr(0), vbTextCompare))
Else
GET_STRING_VALUE = ""
End If
End Select
Else
GET_STRING_VALUE = ""
End If
RegCloseKey hCurKey

Exit Function
ErrHandle:
GET_STRING_VALUE = ""
End Function
Public Function CREATE_REG_KEY(ByVal hKey As Long, ByVal lpSubKey As String) As Long
On Error GoTo ErrHandle
'Data validation
If hKey = 0 Or lpSubKey = "" Then GoTo ErrHandle
If RegCreateKey(hKey, lpSubKey, hCurKey) = ERROR_SUCCESS Then
CREATE_REG_KEY = 1
Else
CREATE_REG_KEY = 0
End If
RegCloseKey hCurKey
Exit Function

ErrHandle:
CREATE_REG_KEY = 0
End Function

Public Function DELETE_REG_KEY(ByVal hKey As Long, ByVal lpSubKey As String) As Long
On Error GoTo ErrHandle
'Data validation
If hKey = 0 Or lpSubKey = "" Then GoTo ErrHandle
If RegDeleteKey(hKey, lpSubKey) = ERROR_SUCCESS Then
DELETE_REG_KEY = 1
Else
DELETE_REG_KEY = 0
End If
Exit Function

ErrHandle:
DELETE_REG_KEY = 0
End Function

Public Function CREATE_REG_STRING(ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpString As String, ByVal dwType As Long, ByVal lpData As String) As Long
On Error GoTo ErrHandle
'Data validation
If hKey = 0 Or lpSubKey = "" Or lpString = "" Then GoTo ErrHandle

'Open the given hkey + subkey
If RegOpenKey(hKey, lpSubKey, hCurKey) = ERROR_SUCCESS Then
'Create the given string + value
If RegSetValueEx(hCurKey, lpString, 0, dwType, ByVal lpData, Len(lpData)) = ERROR_SUCCESS Then
CREATE_REG_STRING = 1
Else
CREATE_REG_STRING = 0
End If
Else
'Create the given hkey + subkey
If RegCreateKey(hKey, lpSubKey, hCurKey) = ERROR_SUCCESS Then
'Create the given string + value
If RegSetValueEx(hCurKey, lpString, 0, dwType, ByVal lpData, Len(lpData)) = ERROR_SUCCESS Then
CREATE_REG_STRING = 1
Else
CREATE_REG_STRING = 0
End If
Else
CREATE_REG_STRING = 0
End If
End If
RegCloseKey hCurKey

Exit Function
ErrHandle:
CREATE_REG_STRING = 0
End Function

Public Function SET_STRING_VALUE(ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpString As String, ByVal dwType As Long, ByVal lpData As String) As Long
On Error GoTo ErrHandle
'Data validation
If hKey = 0 Or lpSubKey = "" Or lpString = "" Then GoTo ErrHandle

'Open the given hkey + subkey
If RegOpenKey(hKey, lpSubKey, hCurKey) = ERROR_SUCCESS Then
'Create the given string + value
If RegSetValueEx(hCurKey, lpString, 0, dwType, ByVal lpData, Len(lpData)) = ERROR_SUCCESS Then
SET_STRING_VALUE = 1
Else
SET_STRING_VALUE = 0
End If
Else
SET_STRING_VALUE = 0
End If
RegCloseKey hCurKey

Exit Function
ErrHandle:
SET_STRING_VALUE = 0
End Function