IE拡張 : リンク下の情報を取得してクリップボードへコピー

インストールは AppData\Roaming\laylaClass に行われます。
アンインストールは、同梱の uninstall.reg をエクスプローラからダブルクリックして下さい

上記 .reg でレジストリより削除します。
実行ファイル(anchor_url.htm)は、AppData\Roaming\laylaClass\menuex 内より削除して下さい。
※ 実行ファイル(anchor_url.htm)は、削除しなくても Windows には影響ありません)


IE拡張メニューです。
ページ上で右クリックして表示されるポップアップメニューから起動される IE 専用アプリケーションです。

▼一例▼

画像、テキストリンク兼用です。

通常は、リンクされている部分の URL を取得します

<a href="url">タイトル</a>
<a href="url"><img src="url"></a>

※ 画像のみの場合は、画像の URL を取得
<img src="url">

SHIFT キーを押しながらだとリンクの HTML を全て取得します

<a href="url"><b>タイトル</b></a>

CTRL キーを押しながらだと現在のA要素のHTMLを全て取得します

<a href="url"><b>タイトル</b></a>

<JOB>
<COMMENT>
************************************************************
IE 拡張メニューインストーラ

■アンカー下 URL 取得

テキストリンクと画像専用です。

通常は、リンクされている部分の URL を取得し、
SHIFT キーを押しながらだとリンクの内側を取得します
CTRL キーを押しながらだと、現在の A 要素の内部の情報を全て取得します

■著作権その他

このプログラムはフリーです。どうぞ自由に御使用ください。
著作権は作者である私(lightbox)が保有しています。
また、本ソフトを運用した結果については、作者は一切責任を
負えせんのでご了承ください。
************************************************************
</COMMENT>

<SCRIPT
	language="VBScript"
	src="http://lightbox.in.coocan.jp/laylaClass.vbs">
</SCRIPT>

<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************
Call laylaFunctionTarget( "http://lightbox.in.coocan.jp/" )
Call laylaLoadFunction( "baseFunction.vbs" )

' //////////////////////////////////////////////////////////
' インストール時の表示名
strProgName	= "リンクのURL"
' インストールファイル名( 拡張子は .htm となる )
strProgFile	= "anchor_url"
' メニューとウインドウのタイトルに表示する文字列
' レジストリに登録するのでユニークである必要があります
strRegName	= strProgName
' 対象となるコンンテンツ
nTargetType 	= &H22
' &H3F : UNKNOWNを除く全て
' &H1  : DEFAULT
' &H2  : IMAGE
' &H4  : CONTROL
' &H8  : TABLE
' &H10 : TEXTSELECT
' &H20 : ANCHOR
' &H40 : UNKNOWN

' 画面ありかどうか
bIsGUI = False
' //////////////////////////////////////////////////////////



' Csript.exe で実行を強制
Crun

print strProgName & " をインストールします"
if not OkCancel( "インストールしてもよろしいですか?" ) then
	Wscript.Quit
end if

' ファイルシステムオブジェクト作成
GetFso

' 問題をできるだけ避ける為にc ドライブ固定(必要ならばここを変更)
strPath =  GetShellDir( &h1a )
strInstallPath1 = strPath & "\laylaClass"
strInstallPath2 = strInstallPath1 & "\menuex"
strInstallPath3 = strInstallPath2 & "\" & strProgFile & ".htm"
on error resume next
if not Fso.FolderExists( strInstallPath1 ) then
	Call Fso.CreateFolder( strInstallPath1 )
	if Err.Number <> 0 then
		ErrorFlg = True
	end if
end if
if not Fso.FolderExists( strInstallPath2 ) then
	Call Fso.CreateFolder( strInstallPath2 )
	if Err.Number <> 0 then
		ErrorFlg = True
	end if
end if
on error goto 0

Call PutTextFile( strInstallPath3, _
Replace(GetInline("MenuExt"),"$REGNAME", strRegName ) )

' レジストリ処理用オブジェクト作成
GetWshShell

on error resume next
WshShell.RegWrite _
	"HKCU\Software\Microsoft\Internet Explorer\MenuExt\"&strRegName&"\", _
	strInstallPath3, _
	"REG_SZ"
WshShell.RegWrite _
	"HKCU\Software\Microsoft\Internet Explorer\MenuExt\"&strRegName&"\Contexts", _
	nTargetType, _
	"REG_DWORD"

if bIsGUI then
	' この定義があると、画面あり
	WshShell.RegWrite _
		"HKCU\Software\Microsoft\Internet Explorer\MenuExt\"&strRegName&"\Flags", _
		&H1, _
		"REG_DWORD"
end if
on error goto 0

print "処理が終了しました"
print ""

Wscript.Quit

</SCRIPT>

<COMMENT>
******** ●ここを変更● ********
</COMMENT>
<RESOURCE id="MenuExt">
<![CDATA[
<meta http-equiv="content-type" content="text/html; charset=SHIFT_JIS">
<SCRIPT language="VBScript">

	Dim WshShell,RegName,strLocation,obj,doc

	Set WshShell = CreateObject("WScript.Shell")
	RegName = "$REGNAME"

	' *************************************************
	' ウインドウサイズ
	' *************************************************
'	window.dialogWidth = "900px"
'	window.dialogHeight = "610px"

'	window.dialogTop = "100px"
'	window.dialogLeft = (window.screen.width/2)&"px"

	on error resume next
	ExecuteGlobal "function dummy(): end function"
	on error goto 0

	' SHIFTとCTRL用変数
	Dim keyflg1,keyflg2
	keyflg1 = False
	keyflg2 = False

Function setObj( src )
	Set obj = src
End Function
</SCRIPT>

<SCRIPT language="JavaScript">
setObj(external.menuArguments.event.srcElement);
</SCRIPT>
<html>
<head>
<title>$REGNAME</title>
<meta http-equiv="content-type" content="text/html; charset=SHIFT_JIS">
<base target="_self">
</head>
<BODY>
<!--SHIFTとCTRLがおされているかどうかを取得するボタン-->
<INPUT id="btn" type=button onClick='keyflg1=window.event.shiftKey:keyflg2=window.event.ctrlKey'>
</BODY>
</html>
<SCRIPT language="VBScript">

	' ボタンの呼び出し
	document.getElementById("btn").click()

	on error resume next
	' *************************************************
	' 画像とアンカーの処理( レジストリ 0x22 )
	' obj は、カーソル下のオブジェクト
	' *************************************************
	Dim fobj
	Set fobj = obj
	tag = obj.tagName
	if Err.Number <> 0 then
		str = "カーソル下のオブジェクトを取得できませんでした"
	else

		tag = Ucase( tag )
		' *************************************************
		' リンクの場合
		' *************************************************
		if tag = "A" then

			if keyflg1 then
				stra = obj.innerHTML
			else
				if keyflg2 then
					stra = obj.outerHTML
				else 
					stra = obj.href
				end if
			end if 

			Call window.clipboardData.setData("Text", stra )
			str = stra

		end if

		' *************************************************
		' 画像の場合
		' *************************************************
		if tag = "IMG" then

			Dim nCnt
			nCnt = 0
			Do While True
				stra = Ucase(obj.parentElement.tagName)
				if stra = "BODY" then
					stra = fobj.src
					Exit Do
				end if
				if stra = "A" then
					if keyflg1 then
						stra = obj.parentElement.innerHTML
					else
						if keyflg2 then
							stra = obj.parentElement.outerHTML
						else 
							stra = obj.parentElement.href
						end if
					end if 
					Exit Do
				end if
				Set obj = obj.parentElement
				nCnt = nCnt + 1
				if nCnt > 100 then
					alert("階層が深すぎます　　　")
					Exit Do
				end if
			Loop

			Call window.clipboardData.setData("Text", stra )
			str = stra

		end if

	end if
	on error goto 0

	alert(str)


</SCRIPT>
]]>
</RESOURCE>

</JOB>