GetAssocTool - Получение пути к программе, асоциированной с расширением имени файла
Задаем интересующий тип файлов,
получаем путь к приложению по-умолчанию для открытия этого расширения.
Код (vb.net):
ext = inputbox ("Введите расширение имени файла:")
Path = GetAssocTool(ext)
Name = GetFileNameFromPath(Path)
msgbox "Расширение: " & ext & vbLf & "Имя файла: " & Name & vbLf & "Путь: " & Path
Function GetAssocTool(ext)
'Получение пути к приложению, с которым ассоциировано расширение имени файла
if left(ext,1) <> "." then ext = "." & ext
if GetOSFamily() = "NT" then GetAssocTool = GetAssocTool_XP(ext) else GetAssocTool = GetAssocTool_Vista(ext)
End Function
Function GetAssocTool_Vista(ext)
user_key = "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" & ext & "\UserChoice\Progid"
set oShell = CreateObject("WScript.Shell")
on error resume next
progID = oShell.RegRead(user_key)
on error goto 0
if progid = "" then progID = oShell.RegRead("HKCR\" & ext & "\")
comm = oShell.RegRead("HKCR\" & progID & "\shell\open\command\")
GetAssocTool_Vista = ParsePathFromCommandLine(comm)
End Function
Function GetAssocTool_XP(ext)
curSID = GetCurrentSID()
set oShell = CreateObject("WScript.Shell")
on error resume next
EXE_Name = oShell.RegRead("HKEY_USERS\" & curSID & "\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\.txt\Application")
on error goto 0
if EXE_Name <> "" then
comm = oShell.RegRead("HKCR\Applications\" & EXE_Name & "\shell\open\command\")
else
progID = oShell.RegRead("HKCR\" & ext & "\")
comm = oShell.RegRead("HKCR\" & progID & "\shell\open\command\")
end if
GetAssocTool_XP = ParsePathFromCommandLine(comm)
End Function
Function ParsePathFromCommandLine(comm)
'Получает путь из командной строки, если кроме него заданы дополнительные аргументы; убирает кавычки
If Left(comm, 1) = """" Then
ParsePathFromCommandLine = Mid(comm, 2, InStr(2, comm, """") - 2)
Else
ParsePathFromCommandLine = Split(comm)(0)
End If
End Function
Function GetFileNameFromPath(sPath)
'Преобразование пути в имя файла
if instr(sPath,"\") = 0 then GetFileNameFromPath = sPath: Exit Function
GetFileNameFromPath = Mid(sPath, InStrRev(sPath, "\") + 1)
End Function
Function GetCurrentSID()
'Получить SID текущего пользователя
Set oNetwork = CreateObject("WScript.Network")
sUserName = oNetwork.UserName
sDomain = oNetwork.UserDomain
Set oWMI = GetObject("winmgmts:\root\cimv2")
Set colSIDs = oWMI.ExecQuery("SELECT * FROM Win32_UserAccount WHERE Caption='" & sDomain & "\\" & sUserName & "'")
For each oSID in colSIDs
GetCurrentSID = oSID.SID
Next
Set oWMI = Nothing: Set colSIDs = Nothing
End Function
Function GetOSFamily()
' Семейство ОС
set oShell = CreateObject("WScript.Shell")
OSVersion = oShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
if cint(left(OSVersion,1)) < 6 then GetOSFamily = "NT" else GetOSFamily = "Vista"
End Function
Вложения: