HKEY_CLASSES_ROOT\Word.Document.8\shell\Open\command

My program needs to open files like BMP,HTML, JPG, MPG, FLA, and more multimedia files. To open the files my program uses this module to obtain the command that opens the files using the Shell <command> command. This modules works fine with the most files, but it does not word with MS Office files such as Excel Word PowerPoint because the
HKEY_CLASSES_ROOT\Word.Document.8\shell\Open\command is deferent to all other open command keys.

Does anyone know a better way to do it?


Here is my module:

Option Explicit

'Registry Constants
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&
Public Const REG_SZ = 1 ' Unicode nul terminated string
Public Const REG_DWORD = 4
Public Const REG_EXPANDSZ = 2

'Registry API Declarations
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal HKey As Long) As Long

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



Public Function fGetstring(HKey As Long, strPath As String, strValue As String)
Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
Dim r
Dim lValueType

'Open register key
r = RegOpenKey(HKey, strPath, keyhand)
'Query registry
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Or lValueType = REG_EXPANDSZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))
If intZeroPos > 0 Then
fGetstring = Left$(strBuf, intZeroPos - 1)
Else
fGetstring = strBuf
End If
End If
End If
End Function


Public Function getClassName(extention As String) As String
getClassName = fGetstring(HKEY_CLASSES_ROOT, "." & extention, "")
End Function

Public Function getClassNaming(classname As String) As String
getClassNaming = register.fGetstring(HKEY_CLASSES_ROOT, classname, "")
End Function

Public Function getOpenCommand(classname As String, filename As String) As String
Dim tempstring As String
Dim char As String
Dim stringpos As Integer

Dim stringleft
Dim stringright

tempstring = register.fGetstring(HKEY_CLASSES_ROOT, classname & "\Shell\Open\Command", "")

'-- Skip if tempstring is ""

If tempstring <> "" Then

'-- Replace %Systemroot% with systemroot.
'
stringpos = InStr(1, tempstring, "%systemroot%", vbTextCompare)
If stringpos > 0 Then
stringleft = Left(tempstring, stringpos - 1)
stringright = Right(tempstring, Len(tempstring) - 13)
tempstring = stringleft & Environ("SYSTEMROOT") & "\" & stringright
End If

stringpos = 0

'-- Replace %1 with filename
'
stringpos = InStr(1, tempstring, "%1", vbTextCompare)
If stringpos > 0 Then
stringleft = Left(tempstring, stringpos - 1)
stringright = Right(tempstring, Len(tempstring) - stringpos - 1)
tempstring = stringleft & filename & stringright
End If



getOpenCommand = tempstring
End If


End Function