Обработка двойных расширений в windows.
Jan. 12th, 2015 06:19 am![[personal profile]](https://www.dreamwidth.org/img/silk/identity/user.png){kind=small}
zepeteWindows это делать не умеет, хотя иногда надо для открытия электронных книг с расширением fb2.zip двойным щелчком.
Для реализации этого я создал скрипт на vbs, который должен выполняться без всяких расширений.
Как его использовать написано в шапке скрипта.
Ниписано на vbs, а не на js, так как js не передает переменные в подпрограммы по значению, а vbs по ссылке, поэтому подпрограммы могут возвращать несколько значений, что важно для доступа к реестру через wmi. Всего около 1000 строк.
Для реализации этого я создал скрипт на vbs, который должен выполняться без всяких расширений.
Как его использовать написано в шапке скрипта.
Ниписано на vbs, а не на js, так как js не передает переменные в подпрограммы по значению, а vbs по ссылке, поэтому подпрограммы могут возвращать несколько значений, что важно для доступа к реестру через wmi. Всего около 1000 строк.
'********************************************************************************
'* скрипт обработки двойных расширений zepete
'*
'* регистрация расширения
'* DoubleExtHandler.vbs /opcode:iext /ext:ext.ext /exe:"X:\yyyy\file.exe"
'* удаление расширения
'* DoubleExtHandler.vbs /opcode:dext /ext:ext.ext
'* удаление всех расширений
'* DoubleExtHandler.vbs /opcode:uninstall /ext:ext.ext
'* запуск обработчика определенного двойного расширения вручную
'* DoubleExtHandler.vbs /opcode:exe /Doc:"X:\yyyy\file.exe"
'* запуск заглушки обработчика файлов
'* DoubleExtHandler.vbs /opcode:stub /Doc:"X:\yyyy\file.exe"
'* запуск проверки на ошибки в реестре
'* DoubleExtHandler.vbs /opcode:chk
'* краткая справка
'* DoubleExtHandler.vbs
'* Автор zepete.livejournal.com
'********************************************************************************
Option Explicit
const HKEY_CLASSES_ROOT = &H80000000 : const HKCR=&H80000000
const HKEY_CURRENT_USER = &H80000001 : const HKCU=&H80000001
const HKEY_LOCAL_MACHINE = &H80000002 : const HKLM=&H80000002
const HKEY_USERS = &H80000003
const HKEY_CURRENT_CONFIG = &H80000005 : const HKCC=&H80000005
const HKEY_DYN_DATA = &H80000006 'только для Windows 95 и Windows 98
const REG_SZ = 1
const REG_EXPAND_SZ = 2
const REG_BINARY = 3
const REG_DWORD = 4
const REG_MULTI_SZ = 7
const cmdKeyOpcode = "opcode"
const cmdKeyOpIExt = "iext"
const cmdKeyOpDExt = "dext"
const cmdKeyOpUn = "uninstall"
const cmdKeyOpExe = "exe"
const cmdKeyOpDChk = "chk"
const cmdKeyOpStub = "stub"
const cmdKeyExt = "ext"
const cmdKeyExe = "exe"
const cmdFile = "Doc"
const regmyKeyName = "DoubleExtHandler"
const regmysubkey = "DoubleExtHandler"
const regMainKey = "MainKey"
dim objArgs : set objArgs=WScript.Arguments
dim objNamedArgs : set objNamedArgs=objArgs.Named
dim objUnnamedArgs : set objUnnamedArgs=objArgs.Unnamed
dim FSO : set FSO=CreateObject("Scripting.FileSystemObject")
dim WshShell : set WshShell=CreateObject("WScript.Shell")
function ReadRegValue(hDefKey,key,regval,val)
ReadRegValue=false
dim str
if key="" then
str="\"®val
else
str="\"&key&"\"®val
end if
if ExistRegValue(hDefKey,key,regval)=false then exit function
On Error Resume Next
err.clear
select case hDefKey
case HKCR
val=WshShell.RegRead("HKCR"&str)
case HKCU
val=WshShell.RegRead("HKCU"&str)
case HKLM
val=WshShell.RegRead("HKLM"&str)
case HKCC
val=WshShell.RegRead("HKCC"&str)
case HKEY_USERS
val=WshShell.RegRead("HKEY_USERS"&str)
case HKEY_DYN_DATA
val=WshShell.RegRead("HKEY_DYN_DATA"&str)
case else
exit function
end select
if err.Number<>0 then exit function
On Error Goto 0
ReadRegValue=true
end function
function ReadRegKey(hDefKey,key,subkey,val)
ReadRegKey=false
dim str
if key="" then
str="\"&subkey&"\"
else
str="\"&key&"\"&subkey&"\"
end if
if ExistKey(hDefKey,key,subkey)=false then exit function
On Error Resume Next
err.clear
select case hDefKey
case HKCR
val=WshShell.RegRead("HKCR"&str)
case HKCU
val=WshShell.RegRead("HKCU"&str)
case HKLM
val=WshShell.RegRead("HKLM"&str)
case HKCC
val=WshShell.RegRead("HKCC"&str)
case HKEY_USERS
val=WshShell.RegRead("HKEY_USERS"&str)
case HKEY_DYN_DATA
val=WshShell.RegRead("HKEY_DYN_DATA"&str)
case else
exit function
end select
if err.Number<>0 then exit function
On Error Goto 0
ReadRegKey=true
end function
function IsExist(path)
IsExist=false
if FSO.FileExists(path)=false then exit function
dim file : set file=FSO.GetFile(path)
if file.Size=0 then exit function
IsExist=true
end function
function GetTempFileName()
dim tempfolder : set tempfolder=FSO.GetSpecialFolder(2)
GetTempFileName=tempfolder.path
GetTempFileName=tempfolder.path&"\"&FSO.GetTempName()
end function
sub DelRegValue(regValue)
'удаляет ключи реестра без вылета из программы
On Error Resume Next
WshShell.RegDelete regValue
' if err.Number<>0 then MsgBox err.Description
On Error Goto 0
end sub
sub ErrorExit(str)
WScript.Echo str
WScript.Quit
end sub
function ExistRegValue(hDefKey,sSubKeyName,sValue)
ExistRegValue = false
dim objReg : Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
dim sNames, Types,str
if objReg.EnumValues(hDefKey, sSubKeyName, sNames,Types)<> 0 then exit function
if IsArray(sNames) = False then exit function
For Each str In sNames
if str=sValue then ExistRegValue=true : exit function
next
end function
function ExistRegValueRegExp(hDefKey,sSubKeyName,sValue)
ExistRegValueRegExp = false
dim objRegExp: Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = sValue
dim objReg : Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
dim sNames, Types,str
if objReg.EnumValues(hDefKey, sSubKeyName, sNames,Types)<> 0 then exit function
if IsArray(sNames) = False then exit function
For Each str In sNames
if objRegExp.Test(str) then ExistRegValueRegExp=true : exit function
next
end function
function ExistKey(hDefKey,sSubKeyName,sSubKey)
ExistKey = false
dim objReg : Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
dim sNames, str
if objReg.EnumKey(hDefKey, sSubKeyName, sNames)<> 0 then exit function
if IsArray(sNames) = False then exit function
For Each str In sNames
if str=sSubKey then ExistKey=true : exit function
next
end function
function IsExeFile(Path)
'проверка на запускаемый файл
IsExeFile=false
dim ipath : ipath=Trim(UCase(Path))
if Len(ipath) = 0 then exit function
dim exts
exts=Split(ipath,".")
Select Case exts(UBound(exts))
Case "BAT","BIN","CMD","COM","CPL","EXE","GADGET","JSE","JS","LNK","MSI","PIF","PS1","SCT","VB","VBE","VBS","VBSCRIPT","WS","WSF"
if FSO.FileExists(ipath)=false then ErrorExit "Error: file """&ipath&""" do not exist"
dim fileexe : set fileexe=FSO.GetFile(ipath)
if fileexe.Attributes and 16 then ErrorExit "Error: file name """&ipath&""" is directory"
if fileexe.Attributes and 8 then ErrorExit "Error: file name """&ipath&""" is Volume"
if fileexe.Size=0 then ErrorExit "Error: file """&ipath&""" is empty"
dim driveexe : set driveexe=FSO.GetDrive(fileexe.Drive.DriveLetter&":")
if driveexe.DriveType <> 2 then ErrorExit "Error: drive consider file """&ipath&""" do not no-removable"
IsExeFile=true
Case Else
ErrorExit "File """&ipath&""" have bad extension"
End Select
end function
function IsExeFileN(Path)
'проверка на запускаемый файл
IsExeFileN=false
dim ipath : ipath=Trim(UCase(Path))
if Len(ipath) = 0 then exit function
dim exts
exts=Split(ipath,".")
Select Case exts(UBound(exts))
Case "BAT","BIN","CMD","COM","CPL","EXE","GADGET","JSE","JS","LNK","MSI","PIF","PS1","SCT","VB","VBE","VBS","VBSCRIPT","WS","WSF"
if FSO.FileExists(ipath)=false then exit function
dim fileexe : set fileexe=FSO.GetFile(ipath)
if fileexe.Attributes and 16 then exit function
if fileexe.Attributes and 8 then exit function
if fileexe.Size=0 then exit function
dim driveexe : set driveexe=FSO.GetDrive(fileexe.Drive.DriveLetter&":")
if driveexe.DriveType <> 2 then exit function
IsExeFileN=true
Case Else
exit function
End Select
end function
sub InstallExtension()
On Error Goto 0
stop
dim retcode,Exts
'проверка корректности параметра /Ext
if objNamedArgs.Exists(cmdKeyExt) = 0 then ErrorExit "No /"&cmdKeyExt&":minorext.mainext key"
Exts=objNamedArgs(cmdKeyExt) : Exts=LCase(Trim(Exts))
if Len(Exts) = 0 then ErrorExit "No value key (minorext.mainext) "&Chr(34)&"/"&cmdKeyExt&Chr(34)
dim minorext, mainext
Exts=Split(Exts,".")
if UBound(Exts) <> 1 then ErrorExit "Value of argument "&Chr(34)&"/"&cmdKeyExt&Chr(34)&" must have only one point symbol!"
minorext=Exts(0)
mainext=Exts(1)
'проверка корректности параметра /Exe
if objNamedArgs.Exists(cmdKeyExe) = 0 then ErrorExit "No "&Chr(34)&"/"&cmdKeyExe&":"&Chr(34)&" key"
dim path
path=objNamedArgs(cmdKeyExe)
if IsExeFile(path) = false then ErrorExit "Bad in key "&Chr(34)&"/"&cmdKeyExe&":"&Chr(34)&" key"
'поиск ключа в реестре, который отвечает за обработку файла
dim originalExtProcKey
dim newKey : newKey=UCase(regmyKeyName)&"_"&UCase(mainext)
if ExistKey(HKCR,"","."&mainext)=false then
do
'обработчика основного расширения нет
'для начал проверяю наличие неприкаянного обработчика, если он есть, то ставлю обработку на него
if ExistKey(HKCR,"",newKey)=true then
WshShell.Run "cmd /c assoc ."&mainext&"="&newkey,0,true
if ExistKey(HKCR,"","."&mainext)=false then ErrorExit "Can not run accos command"
exit do
end if
'а если такого обработчика нет, то ставлю обработку на свою заглужку
retcode=WshShell.RegWrite("HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ")
WshShell.Run "cmd /c assoc ."&mainext&"="&UCase(regmyKeyName),0,true
if ExistKey(HKCR,"","."&mainext)=false then ErrorExit "Can not run accos command"
loop while false
end if
originalExtProcKey=WshShell.RegRead("HKCR\."&mainext&"\")
dim originalExtCommand : originalExtCommand=WshShell.RegRead("HKCR\"&originalExtProcKey&"\shell\open\command\")
dim tempfilepath
if originalExtProcKey <> newKey then
' обработка если еще не установлен новый обработчик
if ExistKey(HKCR,"",newKey)=true then
'есть неприкаянный старый обработчик
'удаляю с него ключ описывающий оригинальный обработчик, если они есть
DelRegValue "HKEY_CLASSES_ROOT\"&newKey&"\"®mysubkey&"\"®MainKey
'тогда копирую из него данные из ключа regmyKeyName во временный файл, если этот ключ существует
if ExistKey(HKCR,newKey,regmysubkey)=true then
tempfilepath=GetTempFileName()
WshShell.Run "reg export ""HKEY_CLASSES_ROOT\"&newKey&"\"®mysubkey&""" """&tempfilepath&"""",0,true
end if
'удаляю этот ключ полностью
WshShell.Run "reg delete ""HKCR\"&newKey&""" /f",0,true
end if
'копирую старый ключ c переименованием
retcode=WshShell.Run("reg copy ""HKCR\" & originalExtProcKey & """ ""HKCR\" & newKey & """ /s",0,true )
'проверка на наличие считанных ключей старого обработчика
if tempfilepath <> empty then
if FSO.FileExists(tempfilepath)=true then
if ExistKey(HKCR,"",newKey&"\"®mysubkey)=true then
WshShell.Run "reg delete ""HKEY_CLASSES_ROOT\"&newKey&"\"®mysubkey&""" /f",0,true
end if
retcode=WshShell.Run("reg import """&tempfilepath&"""",0,true)
FSO.DeleteFile tempfilepath
if retcode<>0 then ErrorExit "Error execute command 'reg import """&tempfilepath&"""'"
end if
end if
'копирование в обработчик пути к команде и оригинального ключа
WshShell.RegWrite "HKEY_CLASSES_ROOT\"&newKey&"\"®mysubkey&"\"®MainKey,originalExtProcKey,"REG_SZ"
end if
'проверка на достоверность оригинального обработчика, если его нет, то попытка заменить его на мою заглушку
do
if ExistRegValue(HKCR,newKey&"\"®mysubkey,regMainKey)=true then
dim oldkey: oldkey=WshShell.RegRead("HKCR\"&newKey&"\"®mysubkey&"\"®MainKey)
if ExistKey(HKCR,"",oldkey)=true then exit do
end if
WshShell.RegWrite "HKCR\"&newKey&"\"®mysubkey&"\"®MainKey,_
UCase(regmyKeyName),"REG_SZ"
loop while false
'копирование в обработчик пути к новой команде
WshShell.RegWrite "HKEY_CLASSES_ROOT\"&newKey&"\"®mysubkey&"\"&"."&minorext,""""&path&""" ""%1""","REG_SZ"
'установка нового обработчика
WshShell.RegWrite "HKEY_CLASSES_ROOT\"&newKey&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpExe&_
" /"&cmdFile&":""%1""","REG_SZ"
WshShell.RegWrite "HKEY_CLASSES_ROOT\."&mainext&"\",newKey,"REG_SZ"
end sub
sub ExecuteCommand
' сам обработчик двойного расширения
if objNamedArgs.Exists(cmdFile) = 0 then ErrorExit "No /"&cmdFile&":""file name"""
dim minorext, mainext, Exts,cmd,filename
filename=LCase(objNamedArgs(cmdFile))
Exts=Split(filename,".")
mainext=Exts(UBound(Exts))
minorext=Exts(UBound(Exts)-1)
dim newKey : newKey=UCase(regmyKeyName)&"_"&UCase(mainext)
'поиск команды для обработки
if ExistRegValue(HKCR,newKey&"\"®mysubkey,"."&minorext)=true then
cmd=WshShell.RegRead("HKEY_CLASSES_ROOT\"&newKey&"\"®mysubkey&"\."&minorext)
' 'редактирование командной строки
cmd=Replace(cmd,"%1",filename)
WshShell.Run cmd,1,false
WScript.Quit
end if
cmd=WshShell.RegRead("HKEY_CLASSES_ROOT\"&newKey&"\"®mysubkey&"\"®MainKey)
cmd=WshShell.RegRead("HKEY_CLASSES_ROOT\"&cmd&"\shell\open\command\")
cmd=Replace(cmd,"%1",filename)
WshShell.Run cmd,1,false
WScript.Quit
end sub
sub OutputStubMsg
' выводится, если нет главного обработчика
if objNamedArgs.Exists(cmdFile) = 0 then ErrorExit "No /"&cmdFile&":""file name"""
dim mainext, Exts,filename
filename=LCase(objNamedArgs(cmdFile))
Exts=Split(filename,".")
mainext=Exts(UBound(Exts))
MsgBox "Stub for processing file with extension """&mainext&""""
WScript.Quit
end sub
'проверка наличия аргументов
if objArgs.Length = 0 then
ErrorExit "Program for processing double extensions in windows"&vbCrLf&_
"cmd line: "_
&WScript.ScriptName&_
" /"&cmdKeyOpcode&":"&cmdKeyOpIExt&_
" /"&cmdKeyExt&":ext.ext /"&_
cmdKeyExe&":'command'"&vbCrLf&_
"Where is:"&vbCrLf&_
" "&cmdKeyOpIExt&" - command for register new extension;"&vbCrLf&_
" ext.ext - registered extensions;"&vbCrLf&_
" command - command that will be called, when open file with extension 'ext.ext'."&vbCrLf&vbCrLf&_
"or command line: "_
&WScript.ScriptName&_
" /"&cmdKeyOpcode&":"&cmdKeyOpExe&_
" /"&cmdFile&":""file name"""&vbCrLf&_
"Where is:"&vbCrLf&_
" "&cmdKeyOpExe&" - command for proccessig file;"&vbCrLf&_
" ""file name"" - proccessing file name"&vbCrLf&vbCrLf&_
"or command line: "_
&WScript.ScriptName&_
" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""file name"""&vbCrLf&_
"Where is:"&vbCrLf&_
" "&cmdKeyOpStub&" - command for output MsgBox with information about absence processing file with this extension;"&vbCrLf&_
" ""file name"" - proccessing file name"&vbCrLf&vbCrLf&_
"or command line: "_
&WScript.ScriptName&_
" /"&cmdKeyOpcode&":"&cmdKeyOpDExt&" /"&cmdKeyExt&":minorext.mainext"&vbCrLf&_
"Where is:"&vbCrLf&_
" "&cmdKeyOpDExt&" - command for erase from windows registry info about minorext.mainext;"&vbCrLf&_
" minorext.mainext - extension info about it command line need delete;"&vbCrLf&vbCrLf&_
"or command line: "_
&WScript.ScriptName&_
" /"&cmdKeyOpcode&":"&cmdKeyOpUn&vbCrLf&_
"Where is:"&vbCrLf&_
" "&cmdKeyOpUn&" - command for erase from windows registry all scripts;"&vbCrLf&vbCrLf&_
"or command line: "_
&WScript.ScriptName&_
" /"&cmdKeyOpcode&":"&cmdKeyOpDChk&vbCrLf&_
"Where is:"&vbCrLf&_
" "&cmdKeyOpDChk&" - command for correct error in windows registry."
end if
'проверка на наличие именованных параметров
if objNamedArgs.Count = 0 then ErrorExit "No named arguments"
'проверка на наличие неименованных параметров
if objUnnamedArgs.Count <> 0 then ErrorExit "No unnamed arguments"
' проверка на команду установки нового обработчика расширений
if objNamedArgs.Exists(cmdKeyOpcode) = 0 then ErrorExit "No "&Chr(34)&"/"&cmdKeyOpcode&Chr(34)&" argumet"
Select Case objNamedArgs(cmdKeyOpcode)
Case cmdKeyOpIExt
InstallExtension
Case cmdKeyOpExe
ExecuteCommand
case cmdKeyOpStub
OutputStubMsg
case cmdKeyOpUn
Uninstall
case cmdKeyOpDExt
DeleteExtension
case cmdKeyOpDChk
CheckRegistry
Case Else
ErrorExit "Bad value key "&Chr(34)&"/"&cmdKeyOpcode&Chr(34)
End Select
sub DeleteExtension
'удаление обработчика расширения
dim retcode,Exts,str
'проверка корректности параметра /Ext
if objNamedArgs.Exists(cmdKeyExt) = 0 then ErrorExit "No /"&cmdKeyExt&":minorext.mainext key"
Exts=objNamedArgs(cmdKeyExt) : Exts=LCase(Trim(Exts))
if Len(Exts) = 0 then ErrorExit "No value key (minorext.mainext) "&Chr(34)&"/"&cmdKeyExt&Chr(34)
dim minorext, mainext
Exts=Split(Exts,".")
minorext=Exts(0)
mainext=Exts(1)
'поиск обработчика основного расширения
dim key,delkey: delkey=UCase(regmyKeyName&"_"&mainext)
'проверка на его наличие
if ExistKey(HKCR,"",delkey)=false then
EraseAll(ext)
ErrorExit "No key """&delkey&""", then erase association it with extension"
end if
'проверяем его на корректность, то есть проверяем то, что в нем есть ссылка на основной обработчик
if ExistRegValue(HKCR,delkey&"\"®mysubkey,regMainKey)=false then
'если это значение отсутствует, то прописываю туда свою заглушку
retcode=WshShell.RegWrite("HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ")
else
On Error Resume Next
Err.Clear
key=WshShell.RegRead("HKCR\"&delkey&"\"®mysubkey&"\"®MainKey)
if err.Number<>0 then ErrorExit "Can not read windows registry"
On Error Goto 0
'проверяю значение ключа на достоверность
if ExistKey(HKCR,"",key)=false then
'ключ не существует, поэтому пытаюсь прочитать значение ключа "HKCR\."&mainext
'которое в случае достоверности, буду использовать,
'как значение ключа "HKCR\"&delkey&"\"®mysubkey&"\"®MainKey
if ReadRegKey(HKCR,"","."&mainext,key)=true then
'проверка на достоверность
if ExistKey(HKCR,"",key)=true then
'проверяю его на "HKCR\"&delkey
if key<>"HKCR\"&delkey then
'изменяю значение
WshShell.RegWrite "HKCR\"&delkey&"\"®mysubkey&"\"®MainKey&"\",key,"REG_SZ"
else
'ставлю свой обработчик
retcode=WshShell.RegWrite("HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ")
end if
else
retcode=WshShell.RegWrite("HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ")
end if
else
retcode=WshShell.RegWrite("HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ")
end if
end if
end if
'проверка на наличие достоверных обработчиков подключей
dim objReg : Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
dim objRegExp: Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = UCase("^[.]")
dim sNames,Types,i
if objReg.EnumValues(HKCR, delkey&"\"®mysubkey, sNames,Types)<> 0 then ErrorExit "Can not enumeration windows registry keys."
if IsArray(sNames) = False then ErrorExit "Can not read hive HKCR."
i=0
For Each str In sNames
if objRegExp.Test(str) then
'проверка значения этого значения на существование
'если его нет, то удаляю
if ReadRegValue(HKCR,delkey&"\"®mysubkey,str,key) then
i=i+1
end if
end if
next
if i=0 then
EraseAll(ext)
ErrorExit "No valid windows registry value ""HKCR\"&delkey&"\"®mysubkey&"\.ext"", then erase association it with extension"
end if
'проверяю значение ключа отвечающего за расширение основное на совпадение с моим обработчиком
if ReadRegKey(HKCR,"","."&mainext,key) then
if ExistKey(HKCR,"",key)=true then
if key<>delkey then
WshShell.RegWrite "HKCR\"&delkey&"\"®mysubkey&"\"®MainKey&"\",key,"REG_SZ"
WshShell.RegWrite "HKCR\."&mainext&"\",delkey,"REG_SZ"
end if
else
WshShell.RegWrite "HKCR\."&mainext&"\",delkey,"REG_SZ"
end if
else
WshShell.RegWrite "HKCR\."&mainext&"\",delkey,"REG_SZ"
end if
'проверки все пройдены, пора удалять вторичное расширение
For Each str In sNames
if str="."&minorext then
DelRegValue "HKCR\"&delkey&"\"®mysubkey&"\"&str
end if
next
stop
objRegExp.Pattern = UCase("^[.]")
if objReg.EnumValues(HKCR, delkey&"\"®mysubkey, sNames,Types)<> 0 then ErrorExit "Can not enumeration windows registry keys."
if IsArray(sNames) = False then ErrorExit "hive HKCR is empty."
i=0
For Each str In sNames
if objRegExp.Test(str) then
if ReadRegValue(HKCR,delkey&"\"®mysubkey,str,key)=true then
i=i+1
end if
end if
next
if i=0 then
EraseAll(mainext)
end if
end sub
sub Uninstall
'удаление всех ссылок из реестра
dim objReg : Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
dim objRegExp: Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = UCase("^"®myKeyName&"_")
dim sNames, str,ext,key
if objReg.EnumKey(HKCR, "", sNames)<> 0 then ErrorExit "Can not create WMI object for read windows registry."
if IsArray(sNames) = False then ErrorExit "Can not read hive HKCR."
For Each str In sNames
if objRegExp.Test(str) then EraseAll(UCase(Mid(str,len(regmyKeyName)+2)))
next
end sub
sub EraseAll(ext)
dim str, key,delkey: delkey=UCase(regmyKeyName&"_"&ext)
'попытка чтения настоящего обработчика расширения
On Error Resume Next
if ExistRegValue(HKCR,delkey&"\"®mysubkey,regMainKey) then
Err.Clear
key=WshShell.RegRead("HKCR\"&delkey&"\"®mysubkey&"\"®MainKey)
If Err.Numbero=0 Then
if key<>UCase(regmyKeyName) then
'ключ прочитан, проверка на действительность его значения
if ExistKey(HKCR,"",key) then
'ключ существует, поэтому копирую его в основной обработчик, если он существует
'и ссылается на удаляемый ключ
if ExistKey(HKCR,"","."&LCase(ext)) then
Err.Clear
str=WshShell.RegRead("HKCR\."&LCase(ext)&"\")
if err.number=0 then
if str=delkey then
'прописываю в этот ключ настоящий обработчик
WshShell.RegWrite "HKCR\."&LCase(ext)&"\",key,"REG_SZ"
if err.number<>0 then
'изменить значение не удалось, поэтому удаляю ключ
WshShell.Run "reg delete HKCR\."&LCase(ext)&" /f",0,false
WScript.Echo "Error write to windows registry key ""HKCR\."&LCase(ext)&"""."
WScript.Echo "Then erase this key."
end if
else
'удаление обработчик, если ключ, на который он ссылается не существует
if ExistKey(HKCR,"",str)=false then
'изменить значение не удалось, поэтому удаляю ключ
WshShell.Run "reg delete HKCR\."&LCase(ext)&" /f",0,false
WScript.Echo "Error write to windows registry key ""HKCR\."&LCase(ext)&"""."
WScript.Echo "Then erase this key."
end if
end if
else
'прочитать не удалось, поэтому удаляю этот ключ
WshShell.Run "reg delete HKCR\."&LCase(ext)&" /f",0,false
WScript.Echo "Error write to windows registry key ""HKCR\."&LCase(ext)&"""."
WScript.Echo "Then erase this key."
end if
end if
else
'ключ не существует, поэтому проверяю ссылку на удаляемый обработчик
if ExistKey(HKCR,"","."&LCase(ext)) then
Err.Clear
str=WshShell.RegRead("HKCR\."&LCase(ext))
if err.number=0 then
if str=delkey then
WshShell.Run "reg delete HKCR\."&LCase(ext)&" /f",0,false
WScript.Echo "Error read from windows registry key ""HKCR\"&key&""","
WScript.Echo "and ""HKCR\."&LCase(ext)&""" link with this key."
WScript.Echo "Then erase key ""HKCR\."&LCase(ext)&"""."
end if
else
'прочитать не удалось, поэтому удаляю этот ключ
WshShell.Run "reg delete HKCR\."&LCase(ext)&" /f",0,false
WScript.Echo "Error write to windows registry key ""HKCR\."&LCase(ext)&"""."
WScript.Echo "Then erase this key."
end if
end if
end if
else
'удаляю ключ "HKCR\."&LCase(ext)
WshShell.Run "reg delete HKCR\."&LCase(ext)&" /f",0,false
end if
else
'ключ не существует, поэтому проверяю ссылку на удаляемый обработчик
if ExistKey(HKCR,"","."&LCase(ext)) then
Err.Clear
str=WshShell.RegRead("HKCR\."&LCase(ext))
if err.number=0 then
if str=delkey then
WshShell.Run "reg delete HKCR\."&LCase(ext)&" /f",0,false
WScript.Echo "Error value ""HKCR\"&delkey&"\"®mysubkey&"\"®MainKey&"""from windows registry, "
WScript.Echo "and ""HKCR\."&LCase(ext)&""" link with this key."
WScript.Echo "Then erase key ""HKCR\."&LCase(ext)&"""."
end if
else
'прочитать не удалось, поэтому удаляю этот ключ
WshShell.Run "reg delete HKCR\."&LCase(ext)&" /f",0,false
WScript.Echo "Error write to windows registry key ""HKCR\."&LCase(ext)&"""."
WScript.Echo "Then erase this key."
end if
end if
end if
else
'ключ не существует, поэтому проверяю ссылку на удаляемый обработчик
if ExistKey(HKCR,"","."&LCase(ext)) then
Err.Clear
str=WshShell.RegRead("HKCR\."&LCase(ext))
if err.number=0 then
if str=delkey then
WshShell.Run "reg delete HKCR\."&LCase(ext)&" /f",0,false
WScript.Echo "Error value ""HKCR\"&delkey&"\"®mysubkey&"\"®MainKey&"""from windows registry, "
WScript.Echo "and ""HKCR\."&LCase(ext)&""" link with this key."
WScript.Echo "Then erase key ""HKCR\."&LCase(ext)&"""."
end if
else
'прочитать не удалось, поэтому удаляю этот ключ
WshShell.Run "reg delete HKCR\."&LCase(ext)&" /f",0,false
WScript.Echo "Error write to windows registry key ""HKCR\."&LCase(ext)&"""."
WScript.Echo "Then erase this key."
end if
end if
end if
On Error GoTo 0
'удаляю ключ
WshShell.Run "reg delete HKCR\"&delkey&" /f",0,true
'ищу ссылки на ключ "HKCR\"®myKeyName, если они не существуют, то удаляю обработчик "HKCR\"®myKeyName
dim objReg : Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
dim objRegExp: Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = UCase("^[.]")
dim sNames
if objReg.EnumKey(HKCR, "", sNames)<> 0 then ErrorExit "Can not enumeration windows registry keys."
if IsArray(sNames) = False then ErrorExit "Can not read hive HKCR."
For Each str In sNames
if objRegExp.Test(str) then
'проверка значения этого клюяа по умолчанию на UCase(regmyKeyName)
if ReadRegKey(HKCR,"",str,key)=true then
if key=UCase(regmyKeyName) then
WshShell.Run "reg delete HKCR\"&str&" /f",0,true
end if
end if
end if
next
' цикл проверки на нахождение этого обработчика в обработчиках поумолчанию
dim i,val: i=0
objRegExp.Pattern = UCase("^"&UCase(regmyKeyName)&"_")
For Each str In sNames
if objRegExp.Test(str) then
if ReadRegValue(HKCR,str&"\"®mysubkey&"\",regMainKey,val) then
if val=UCase(regmyKeyName) then i=i+1
end if
end if
next
if i=0 then
'Удаляю ключ UCase(regmyKeyName)
WshShell.Run "reg delete HKCR\"&UCase(regmyKeyName)&" /f",0,true
else
dim retcode
'создаю ключ HKCR\"&UCase(regmyKeyName), если его нет
if ExistKey(HKCR,UCase(regmyKeyName)&"\shell\open","command")=false then
retcode=WshShell.RegWrite("HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ")
else
if ReadRegKey(HKCR,UCase(regmyKeyName)&"\shell\open","command",key)=false then
retcode=WshShell.RegWrite("HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ")
end if
end if
end if
end sub
sub CheckRegistry
'проверка реестра
'1. Проверка на обработчики с ошибками в regMainKey
dim objReg : Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
dim objRegExp: Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = UCase("^"®myKeyName&"_")
dim sNames, str,ext,key,val
if objReg.EnumKey(HKCR, "", sNames)<> 0 then ErrorExit "Can not create WMI object for read windows registry."
if IsArray(sNames) = False then ErrorExit "Can not read hive HKCR."
For Each str In sNames
if objRegExp.Test(str) then
ext=LCase(Mid(str,len(regmyKeyName)+2))
if ReadRegValue(HKCR,str&"\"®mysubkey,regMainKey,key) then
if ExistKey(HKCR,"",key)=false then
'попытка чтения регистрации этого расширения
if ReadRegKey(HKCR,"","."&ext,val) then
if ExistKey(HKCR,"",val) then
if val<>str then
if objRegExp.Test(val)=false then
WshShell.RegWrite "HKCR\"&str&"\"®mysubkey&"\"®MainKey,val,"REG_SZ"
WshShell.RegWrite "HKCR\."&ext&"\",str,"REG_SZ"
else
WshShell.RegWrite "HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ"
end if
else
WshShell.RegWrite "HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ"
end if
else
WshShell.RegWrite "HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ"
WshShell.RegWrite "HKCR\."&ext&"\",str,"REG_SZ"
end if
else
WshShell.RegWrite "HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ"
WshShell.RegWrite "HKCR\."&ext&"\",str,"REG_SZ"
end if
end if
else
if ReadRegKey(HKCR,"","."&ext,val) then
if ExistKey(HKCR,"",val) then
if val<>str then
if objRegExp.Test(val)=false then
WshShell.RegWrite "HKCR\"&str&"\"®mysubkey&"\"®MainKey,val,"REG_SZ"
WshShell.RegWrite "HKCR\."&ext&"\",str,"REG_SZ"
else
WshShell.RegWrite "HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ"
end if
else
WshShell.RegWrite "HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ"
end if
else
WshShell.RegWrite "HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ"
WshShell.RegWrite "HKCR\."&ext&"\",str,"REG_SZ"
end if
else
WshShell.RegWrite "HKCR\"&UCase(regmyKeyName)&"\shell\open\command\",_
"wscript """&WScript.ScriptFullName&""" /"&cmdKeyOpcode&":"&cmdKeyOpStub&_
" /"&cmdFile&":""%1""","REG_SZ"
WshShell.RegWrite "HKCR\."&ext&"\",str,"REG_SZ"
end if
end if
end if
next
'2. нахождение обработчиков, в которых есть битые вторичные раширения, или нет норвальных
dim sNames2,types,str2,path,i
if objReg.EnumKey(HKCR, "", sNames)<> 0 then ErrorExit "Can not create WMI object for read windows registry."
if IsArray(sNames) = False then ErrorExit "Can not read hive HKCR."
For Each str In sNames
objRegExp.Pattern = UCase("^"®myKeyName&"_")
if objRegExp.Test(str) then
if objReg.EnumValues(HKCR,str&"\"®mysubkey, sNames2,Types)<> 0 then ErrorExit "Can not enumeration windows registry."
if IsArray(sNames2) = False then ErrorExit "Can not read hive HKCR."
objRegExp.Pattern = UCase("^[.]")
i=0
For Each str2 In sNames2
if objRegExp.Test(str2) then
if ReadRegValue(HKCR,str&"\"®mysubkey,str2,val) then
val=trim(val)
'проверка существования файла, на который ссылается команда
if Asc(val)=Asc("""") then
path=Mid(val,2,InStr(2,val,"""")-2)
else
path=Left(val,InStr(2,val," ")-1)
end if
if IsExeFileN(path) then
i=i+1
else
WshShell.RegDelete "HKCR\"&str&"\"®mysubkey&"\"&str2
end if
else
WshShell.RegDelete "HKCR\"&str&"\"®mysubkey&"\"&str2
end if
end if
next
if i=0 then EraseAll(LCase(Mid(str,len(regmyKeyName)+2)))
end if
next
'3 нахождение обработчиков, на которые нет ссылок с регистрации расширения и исправление этой ошибки
if objReg.EnumKey(HKCR, "", sNames)<> 0 then ErrorExit "Can not create WMI object for read windows registry."
if IsArray(sNames) = False then ErrorExit "Can not read hive HKCR."
objRegExp.Pattern = UCase("^"®myKeyName&"_")
For Each str In sNames
if objRegExp.Test(str) then
ext=LCase(Mid(str,len(regmyKeyName)+2))
if ReadRegKey(HKCR,"","."&ext,val) then
if val<>str then
'если это значение существует
if ExistKey(HKCR,"",val) then
'если оно не ссылается на похожий обработчик
if objRegExp.Test(val)=false then
WshShell.RegWrite "HKCR\"&str&"\"®mysubkey&"\"®MainKey,val,"REG_SZ"
WshShell.RegWrite "HKCR\."&ext&"\",str,"REG_SZ"
else
WshShell.RegWrite "HKCR\."&ext&"\",str,"REG_SZ"
end if
else
WshShell.RegWrite "HKCR\."&ext&"\",str,"REG_SZ"
end if
end if
else
WshShell.RegWrite "HKCR\."&ext&"\",str,"REG_SZ"
end if
end if
next
'4 нахождение регистраций расширений, ссылающихся на несуществующие обработчики
if objReg.EnumKey(HKCR, "", sNames)<> 0 then ErrorExit "Can not create WMI object for read windows registry."
if IsArray(sNames) = False then ErrorExit "Can not read hive HKCR."
For Each str In sNames
objRegExp.Pattern = "^[.]"
if objRegExp.Test(str) then
ext=Mid(str,2)
if ReadRegKey(HKCR,"",str,key) then
objRegExp.Pattern = UCase("^"®myKeyName&"_")
if key=UCase(regmyKeyName&"_"&ext) then
if ExistKey(HKCR,"",key)=false then EraseAll(ext)
elseif key=UCase(regmyKeyName) then
EraseAll(ext)
elseif objRegExp.Test(key) then
EraseAll(ext)
end if
end if
end if
next
'5 удаление ключа UCase(regmyKeyName), если он нигде не используется
if objReg.EnumKey(HKCR, "", sNames)<> 0 then ErrorExit "Can not create WMI object for read windows registry."
if IsArray(sNames) = False then ErrorExit "Can not read hive HKCR."
objRegExp.Pattern = UCase("^"®myKeyName&"_")
i=0
For Each str In sNames
if objRegExp.Test(str) then
ReadRegValue HKCR,str&"\"®mysubkey,regMainKey,key
if key=UCase(regmyKeyName) then i=i+1
end if
next
if i=0 then WshShell.Run "reg delete HKCR\"&UCase(regmyKeyName)&" /f",0,true
end sub
