Тема: JS: открыть в броузере IE родительского окна не новое окно, а вкладку
Возникла мысль, как упростить открытие в IE размещенных в тестовых комментах сайтов специально видоизмененных ссылок - с добавленными в адрес пробелами и всякими спец.символами.
Идею оформил простенькой html-страничкой, вызываемой из контекстноого меню при выделении такой "битой ссылки". Скрипт пробует убрать явно лишние символы, добавляет "http://" (если не было), тестирует доступность адреса методом приведенным в ветке JavaScript: как получить по javascript-ссылке адрес для загрузки файла, если тест успешен, то страничка со скриптом закрывается, а ссылка без лишних вопросов открывается в новом окне IE, если тест неуспешен, то дается возможность перед запуском перехода адрес подправить.
Вот, текст страницы IE_OpenAddrInNewWin.htm:
<!-- IE_OpenAddrInNewWin.htm
Данная страничка выполняет удаление явно некорректных символов в выделенном тексте,
далее полученный текст проверяется в качестве корректного адреса - если с адреса получен положительный ответ,
то он передает новому окну Internet Explorer, иначе - предлагается предварительно его подкорректировать в дополнительном диалоге
Меню вызова этой страницы при выделения в броузере текста настраивается запуском скрипта - "IE_OpenAddrInNewWin_setup.vbs".
-->
<html style="width: 400px; height: 220px; margin: 10px; status:1">
<meta http-equiv="Content-Type" content="text/html; charset=windows-1251">
<meta name="Author" content="R.G.">
<meta name="Description" content="Preparate-test url, open url in new window">
<head>
<title>Open in New Window...</title>
</head>
<!-- ========================================= HTML =========================================== -->
<BODY BGCOLOR="#C0C0C0" onload="Window_OnLoad();">
<div align="center"><small>[<span id="id_recvText" style="color:blue" title="Полученный с родительского окна выделенный текст"></span>]</div>
<br>
<input type="text" name="tParam" size="70" Value=""
style="font-family: Arial; font-size: 11;"
title='Адрес для запуска. <Enter> - открытие адреса в новом окне'>
<br>
<div align="center">
<input id=btGo type=submit value="Go to address"
onclick="var url=document.getElementById('tParam').value;
var win=window.open(url); win.focus(); window.close();"
style="{font-family: Arial; font-size: 12;}"
title="Открытие адреса в новом окне">
<input type=button value="Close" onclick="window.close();" style="{font-family: Arial; font-size: 11;}"
title="Закрытие окна">
<div id="divErrMsg" style="color:Blue" title="Статус теста полученного адреса">
<br>
<br><br><br>
</div>
<hr>
<i> IE_OpenAddrInNewWin.htm v0.2 by 11.10.2012 © R.G.</i>
</div>
<!-- ====================================== VBScript ========================================== -->
<script language="VBScript">
'--- uf_repairAddress()
' Из строки убираются недопустимые в url символы
' в начало, если не было, добавляется протокол "http://"
Function uf_repairAddress(pText)
ret = pText
ret = Trim(ret)
'--- сначала удаляем http://'
iPos = InStr(1, ret, "http://", 1) : If iPos > 0 Then ret = Right(ret, Len(ret) - iPos - 6)
'--- Убираем явно недопустимые символы'
'(символ % не трогаем специально, т.к. это может быть кодирование какого-то ASCII-Character)'
ret = Replace(ret,"//","")
ret = Replace(ret,"\","")
ret = Replace(ret,"!","")
ret = Replace(ret,"@","")
ret = Replace(ret,"$","")
ret = Replace(ret,"^","")
ret = Replace(ret,"&","")
ret = Replace(ret,"*","")
ret = Replace(ret,"+","")
ret = Replace(ret,"(","")
ret = Replace(ret,")","")
ret = Replace(ret,"<","")
ret = Replace(ret,">","")
ret = Replace(ret,"[","")
ret = Replace(ret,"]","")
ret = Replace(ret,"""","")
ret = Replace(ret,"'","")
ret = Replace(ret,":","")
ret = Replace(ret,";","")
ret = Replace(ret," ","")
ret = Replace(ret,"•","")
ret = Replace(ret,"—","")
ret = Replace(ret,"‘","")
ret = Replace(ret,"’","")
ret = Replace(ret,"“","")
ret = Replace(ret,"”","")
For i=192 To 255 '--- в цикле - замена кириллического текста'
ret = Replace(ret,Chr(i),"")
Next
'--- добавляем http://'
ret = "http://" & ret
uf_repairAddress = ret
END FUNCTION
'--- 'uf_testUrl()
' Проверяется доступность адреса ссылки
' "" - возвращается при статусе "ОК", иначе - текст ошибки'
Function uf_testUrl(pUrl)
uf_testUrl = "no data"
'--- Если в проверяемом адресе есть #, укорачиваем урл до этого символа'
iPos = InStr(pUrl,"#") : If iPos>0 Then pUrl = Left(pUrl, iPos - 1)
On Error Resume Next
Dim xmlhttp : Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
xmlhttp.open "GET", pUrl, False
xmlhttp.send
If xmlhttp.status <> 200 Then
uf_testUrl = "<hr>status: " & xmlhttp.status & "<br>" & xmlhttp.statusText
else
uf_testUrl = ""
End If
On Error GoTo 0
END FUNCTION
</script>
<!-- =================================== JScript ============================================== -->
<script language="JavaScript">
var parentwin;
var doc;
// отрабатывает при открытии окна - получение значений из "вызвавшей" страницы
function Window_OnLoad()
{
parentwin = external.menuArguments; // получаем объект окна
doc = parentwin.document; // получаем объект документа
var sel = doc.selection.createRange().text; // получаем текст выделения
document.all.id_recvText.insertAdjacentHTML ("beforeEnd", sel); // отображаем полученный текст
tParam.value = uf_repairAddress(sel);
var errTestUrl = uf_testUrl(tParam.value);
if (errTestUrl) document.all.divErrMsg.innerHTML=errTestUrl; else btGo.onclick();
}
</script>
</body>
</html>Вот, скрипт IE_OpenAddrInNewWin_setup.vbs для настройки меню:
' IE_OpenAddrInNewWin_setup.vbs
' ----------------------------------------------------------------------------------------
' Добавляет/Удаляет в контекстное меню Internet Explorer пункт
' ----------------------------------------------------------------------------------------
'--- имя добавляемого пункта
Const csMenu = "_Open selected HTTP-Address in New Window"
'--- имя прописываемого для пункта HTML-файла
Const csFile = "IE_OpenAddrInNewWin.htm"
'--- описание фцнкционала добавляемого пункта
Const csDescription = "для добавления возможности открытия выделенного на странице адреса в новом окне"
Dim WshShell, FSO
Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
Dim REG_MENUEXT, REG_NEWMENU, rc, sPathApp, sPathHTM
REG_MENUEXT = "HKCU\Software\Microsoft\Internet Explorer\MenuExt\" ' путь к меню Internet Explorer в реестре
sPathApp = fso.GetAbsolutePathName(".") 'путь к каталогу запуска задачи'
sPathHTM = sPathApp & "\" & csFile 'полный путь к HTML-странице
'--- проверка наличия в IE нашего пункта'
If uf_keyExists( REG_MENUEXT & csMenu & "\" ) Then
'--- менюшка уже есть, предлагаем удалить'
rc=MsgBox("Удалять из меню Internet Explorer данный пункт ?" & vbCrLf & vbCrLf & _
"Назначение пункта: " & csDescription & ".", vbQuestion + vbOKCancel, csMenu)
If rc=vbOK Then
WshShell.RegDelete( REG_MENUEXT & csMenu & "\" )
MsgBox "Удаление выполнено." & vbCrLf &_
"Перезапустите Internet Explorer, чтобы изменения вступили в силу" & vbCrLf & vbCrLf, _
vbInformation, "Удаление в IE меню """ & csMenu & """"
End IF
else '--- пункта меню нет, предлагаем установить'
rc = MsgBox("Хотите добавить в контекстное меню Internet Explorer пункт """ & csMenu & """" & vbCrLf & vbCrLf & _
csDescription & vbCrLf & vbCrLf, _
vbYesNo OR vbQuestion, "Установка """ & csMenu & """")
If rc=vbYes Then
' Записываем в реестр требуемые значения
REG_NEWMENU = REG_MENUEXT & csMenu & "\"
WshShell.RegWrite REG_NEWMENU, sPathHTM, "REG_SZ"
WshShell.RegWrite REG_NEWMENU & "Contexts", 4+8+16+32, "REG_DWORD" 'Controls + Tables + Text selection + Anchor'
WshShell.RegWrite REG_NEWMENU & "Flags", 1, "REG_DWORD"
WshShell.RegWrite REG_NEWMENU & "My_Desccription", csDescription, "REG_SZ" 'Собственный.параметр реестра - описание пункта'
MsgBox "Данные были успешно внесены," & vbCrLf & _
"путь к программе прописан следующий - """&sPathHTM&"""." & vbCrLf & vbCrLf & _
"Перезапустите Internet Explorer, чтобы изменения вступили в силу, " &_
"добавленный пункт будет отображаться в контекстном меню при наличии выделенного на странице текста." & vbCrLf &vbCrLf,_
vbInformation, csMenu
End IF
End If
Set FSO = Nothing
Set WshShell = Nothing
'--- проверка наличия ключа реестра'
Function uf_keyExists(key)
Dim key2
On Error Resume Next
key2 = WshShell.RegRead(key)
If Err <> 0 Then
uf_keyExists = False
Else
uf_keyExists = True
End If
On Error GoTo 0
End FunctionИмхо, получилось довольно удобно открывать такие ссылки, но еще хотелось бы, чтобы по возможности открывалось не новое окно броузера, а новая вкладка.
В строке:
onclick="var url=document.getElementById('tParam').value;
var win=window.open(url); win.focus(); window.close();"пробовал "методом тыка" изменять "window.open(url);" на "window.open(url,'_blank');", на "parentwin.open(...);" - открытие в новой вкладке так и не добился.
Прошу Вашей подсказки.
WBR. Roman
