AW: verknüpftes Programm auslesen
31.01.2010 11:14:06
Nepumuk
Hi ihr zwei,
Ok, ich hab da an der falschen Stelle gesucht. Das sind natürlich benutzerdefinierte Einstellungen und darum unter "current User" gespeichert. Versuchen wir es mal so:
Option Explicit
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" ( _
ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByRef phkResult As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" ( _
ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpValueName As String, _
ByRef lpcbValueName As Long, _
ByVal lpReserved As Long, _
ByRef lpType As Long, _
ByRef lpData As Any, _
ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
ByVal hKey As Long) As Long
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const BUFFER_SIZE As Long = 255&
Private Const ERROR_NO_MORE_ITEMS As Long = 259&
Private Function Search_Linked_Program(strExtension As String) As String
Dim lngKey As Long, lngNameLength As Long, lngKeyLength As Long
Dim lngIndex As Long
Dim strName As String, strKey As String, strProgram As String
If Left$(strExtension, 1) <> "." Then strExtension = "." & strExtension
If RegOpenKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\" & _
"Explorer\FileExts\" & strExtension & "\UserChoice", lngKey) = 0 Then
Do
strName = Space$(BUFFER_SIZE)
strKey = Space$(BUFFER_SIZE)
lngNameLength = BUFFER_SIZE
lngKeyLength = BUFFER_SIZE
If RegEnumValue(lngKey, lngIndex, strName, lngNameLength, _
0, ByVal 0&, ByVal strKey, lngKeyLength) = ERROR_NO_MORE_ITEMS Then Exit Do
If lngKeyLength > 0 Then
If Left$(strName, lngNameLength) = "Progid" Then
strProgram = Left$(strKey, lngKeyLength - 1)
Call RegCloseKey(lngKey)
If RegOpenKey(HKEY_CLASSES_ROOT, strProgram & "\shell\open\command", lngKey) = 0 Then
strName = Space$(BUFFER_SIZE)
strKey = Space$(BUFFER_SIZE)
lngNameLength = BUFFER_SIZE
lngKeyLength = BUFFER_SIZE
Call RegEnumValue(lngKey, 0, strName, lngNameLength, _
0, ByVal 0&, ByVal strKey, lngKeyLength)
If lngKeyLength > 0 Then
strKey = Left$(strKey, lngKeyLength - 1)
If Cbool(InStr(1, strKey, Chr$(34))) Then
Search_Linked_Program = Split(strKey, Chr$(34))(1)
Else
Search_Linked_Program = Split(Split(strKey, " ")(1), ",")(0)
End If
Else
Search_Linked_Program = "Kein verknüpftes Programm gefunden"
End If
Call RegCloseKey(lngKey)
Exit Do
End If
End If
End If
lngIndex = lngIndex + 1
Loop
Else
Search_Linked_Program = strExtension & " nicht registriert oder kein Zugriff auf Registry"
End If
End Function
Public Sub Test()
MsgBox Search_Linked_Program(".xls")
End Sub
Gruß
Nepumuk