MyTetra Share
Делитесь знаниями!
Получение пути к программе, асоциированной с расширением имени файла
30.12.2017
22:16
Раздел: VBScript

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
 

 

Вложения:

Прикрепленные файлы:
Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования