Single Post - Переход по указанному в буфере пути или ключу реестра

Hidden text

Code:

' Перейти по ссылке в буфере обмена (БО),
' в том числе обрабатывает ссылки на пути реестра через плагин Registry

On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")

Clipb = CreateObject("HTMLFile").parentWindow.clipboardData.getData("Text")
path=Clipb

CrLfArr = Array(vbnewline, chr(13), chr(10))
For Each a In CrLfArr
path = replace(path, a, "|")
Next
If Err.Number <> 0 then
WshShell.Popup "В буфере обмена нет текста", 1.8 , "Ошибка", vbCritical
Wscript.Quit
End If

'=== Вычленение ссылки-пути регуляркой из содержимого БО ================
path=replace(path, """", "")
path=replace(path, "/", "\")
path=trim(path) & "|"

Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
.Pattern = ".*?(\W|^)(([A-Z]:|\\\\|hk).+?)\|"
.Global = False
.IgnoreCase = True
End With
Set Matches = objRegEx.Execute(path)
Set Match = Matches.Item(0)
Set Submatches = Match.Submatches
path=Trim(Submatches.Item(1))

'=== Обработка ссылок на реестр через плагин Registry ===================
if left(path,1) = "[" or ucase(left(path,2)) = "HK" or lcase(left(path,10)) = "компьютер\" then
path=replace(path, "[", "")
path=replace(path, "]", "")
path=replace(path, "компьютер\", "", 1, 1, 1)
path=replace(path, "hkcr\", "HKEY_CLASSES_ROOT\", 1, 1, 1)
path=replace(path, "hkcc\", "HKEY_CURRENT_CONFIG\", 1, 1, 1)
path=replace(path, "hkcu\", "HKEY_CURRENT_USER\", 1, 1, 1)
path=replace(path, "hklm\", "HKEY_LOCAL_MACHINE\", 1, 1, 1)
path=replace(path, "hku\", "HKEY_USERS\", 1, 1, 1)

pr1=path
if RegPath(pr1)=1 then sposob=1

if isempty(sposob) then
pr2=path & "\"
if RegPath(pr2)=1 then sposob=2
end if

if isempty(sposob) then
pr3=path
for k=1 to 100
pr3=pthminus(pr3)
if RegPath(pr3 & "\")=1 then
sposob=3
if k=1 then NoMsg=1 else NoMsg=0
exit for
end if
next
end if

' msgbox sposob & vbnewline & "pr1=" & pr1 & vbnewline & "pr2=" & pr2 & vbnewline & "pr3=" & pr3

select case sposob
case 1
if right(pr1, 1)="\" then path = left(pr1, len(pr1)-1) else path=pr1
case 2
if right(pr2, 1)="\" then path = left(pr2, len(pr2)-1) else path=pr2
case 3
if right(pr3, 1)="\" then path = left(pr3, len(pr3)-1) else path=pr3
case else
msg = MsgBox("Ветка реестра не найдена:" & string(2, vbnewline) & Clipb, vbCritical, "Ошибка")
Wscript.Quit
end select
path="\\\Registry\" & path
end if

if lcase(left(path,11)) = "\\\registry" then Reg=1
'=========================================================================

TCP = WshShell.ExpandEnvironmentStrings("%commander_exe%")
WshShell.run """" & TCP & """ /O /S /A """ & path & """"

wscript.Sleep 500

EnvPath = replace(WshShell.ExpandEnvironmentStrings(path), "|", "")
If not FSO.FolderExists(path) And _
not FSO.FileExists(path) And _
not FSO.FolderExists(WshShell.ExpandEnvironmentStrings(path)) And _
not FSO.FileExists(WshShell.ExpandEnvironmentStrings(path)) And _
not FSO.FolderExists(EnvPath) And _
not FSO.FileExists(EnvPath) And _
not Reg=1 Then _
msg = MsgBox("Путь не найден:" & vbnewline & vbnewline & Clipb, vbCritical, "Ошибка")

'=== Функции ============================================================
function RegPath(path)
on error resume next
x = WshShell.RegRead(path)
If err.number = 0 Then RegPath=1 else RegPath=0
end function

function pthminus(path)
on error resume next
for i = 1 to len(path)
if mid(path, i, 1) = "\" then slash=i
next
pthminus=left(path, slash-1)
end function