ソース掲示板




すべてから検索

キーワード   条件 表示 現行ログ 過去ログ トピックス 名前 本文
IE 拡張メニュー用アプリケーションのスケルトン
日時： 2018/02/06 19:11
名前： lightbox


 
このスケルトンは、インストーラも兼ねています。

ダウンロード


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

■サンプルアプリケーション
　　1) カーソル下のテキストを取得します
　　2) 選択状態のテキストがあれば、それを取得します
　　3) リンクの場合は、テキストと URL を取得します
　　4) HTML タグによっては( PRE など ) その範囲内のテキスト
　　　 を取得します

■著作権その他

このプログラムはフリーです。どうぞ自由に御使用ください。
著作権は作者である私(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	= "カーソル下テキスト情報取得"
' インストールファイル名( 拡張子は .htm となる )
strProgFile	= "My_ie_MenuExt"

' メニューとウインドウのタイトルに表示する文字列
' レジストリに登録するのでユニークである必要があります
strRegName	= "－★カーソル下テキスト情報取得"
' 対象となるコンンテンツ
nTargetType 	= &H3F
' &H3F : UNKNOWNを除く全て
' &H1  : DEFAULT
' &H2  : IMAGE
' &H4  : CONTROL
' &H8  : TABLE
' &H10 : TEXTSELECT
' &H20 : ANCHOR
' &H40 : UNKNOWN

' 画面ありがどうか
bIsGUI = True
' //////////////////////////////////////////////////////////



' Csript.exe で実行を強制
Crun

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

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

strInstallPath1 = "c:\laylaClass"
strInstallPath2 = "c:\laylaClass\menuex"
strInstallPath3 = "c:\laylaClass\menuex\" & 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[
<SCRIPT language="VBScript">

	Dim WshShell,RegName,strLocation,obj,doc

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

	' *************************************************
	' ウインドウサイズ
	' *************************************************
	window.dialogWidth = "800px"
	window.dialogHeight = "600px"

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

	strLocation = external.menuArguments.location

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

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">
<STYLE type="text/css">
* {
	font-size:12px;
}
body {
	margin:0;
}
</STYLE>

<SCRIPT language="VBScript">

	' 関数定義用


</SCRIPT>
<base target="_self">
</head>
<BODY>

<FORM
	method="POST"
	action="http://host/サーバ側処理.php"
>
<TEXTAREA
	name="text"
	style='width:790px;height:550px;'
></TEXTAREA>
<INPUT
	type="submit"
	name="send"
	value="送信"
><br>
</FORM>

</BODY>
</html>
<SCRIPT for=window event=onload language="VBScript">

	' onload 処理
	Set doc = obj.document

	set objTextArea = doc.selection
	set objTextRange = objTextArea.createRange( )
	on error resume next
	strData = objTextRange.text
	nLen = Len( strData )
	on error goto 0

	if nLen <> 0 then
		document.getElementsByName("text")(0).value = strData
	else
		strTag = obj.tagName
		if UCase( strTag ) = "A" then
			strWork = obj.innerText
			strWork = strWork & vbCrLf & obj.href
			document.getElementsByName("text")(0).value = strWork
		else
			document.getElementsByName("text")(0).value = obj.innerText
		end if
	end if

</SCRIPT>
]]>
</RESOURCE>

</JOB>
メンテナンス

Basp21 を使う場合のメール設定 ( No.1 )
 日時： 2009/04/07 11:40
名前： lightbox
日時： 2009/04/07 11:40
名前： lightbox
C:\laylaClass\menuex\send_mail_text_basp21.htm の先頭にあるメール
情報を直接変更します。但し、メールパスワードがそのまま入力されるので、
重要では無いメールアドレスにする必要があります。
一番いいのは、ローカルにメールサーバをインストールする事です。

さくらならば、同一ドメイン内ならばユーザとパスワードの設定は必要無かったです。
外部にメールする場合は以下のようになります

拡張子:
SMTPServer	= "sakuraユーザID.sakura.ne.jp:587"
MailTo		= "宛先"
MailFrom		= "<メールID@sakuraユーザID.sakura.ne.jp>" & _
	vbTab & "メールID@sakuraユーザID.sakura.ne.jp:パスワード"




フリーメールは、Yahoo が以下で動作します

拡張子:
SMTPServer	= "smtp.mail.yahoo.co.jp:587"
MailTo		= "宛先"
MailFrom		= "<ユーザID@yahoo.co.jp>" & vbTab & "ユーザID:パスワード"


※ メールオプション(POPアクセスとメール転送)で、「ブラウザアクセスとPOPアクセス」に設定する必要があります


CDO.Message 版は
C:\laylaClass\menuex\send_mail_text_CDOMessage.htm 
を変更します
このアーティクルの参照用URLをクリップボードにコピー メンテナンス
カーソル下のテキストを basp21 でメール送信 ( No.2 )
日時： 2018/02/06 19:12
名前： lightbox
拡張子:
<JOB>
<COMMENT>
************************************************************
IE 拡張メニューインストーラ

■カーソル下のテキストを basp21 でメール送信

　　 http://www.hi-ho.ne.jp/babaq/basp21.html から
　　 basp21 をダウンロードしてインストールしている必要
　　 があります。

　　インストール時に以下の情報を入力する必要があります。
　　( 何度でもインストールしなおせます )
　　一度インストールしたら、直接
　�またはIPアドレス
　　2) 宛先
　　3) 差出人
　　4) メールのタイトル

------------------------------------------------------------

　　1) カーソル下のテキストを取得します
　　2) 選択状態のテキストがあれば、それを取得します
　　3) リンクの場合は、テキストと URL を取得します
　　4) HTML タグによっては( PRE など ) その範囲内のテキスト
　　　 を取得します

■著作権その他

このプログラムはフリーです。どうぞ自由に御使用ください。
著作権は作者である私(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	= "ブラウザの情報をメール(basp21)で送る"
' インストールファイル名( 拡張子は .htm となる )
strProgFile	= "send_mail_text_basp21"

' メニューとウインドウのタイトルに表示する文字列
' レジストリに登録するのでユニークである必要があります
strRegName	= "－★ブラウザの情報をメール(basp21)で送る"
' 対象となるコンンテンツ
nTargetType 	= &H3F
' &H3F : UNKNOWNを除く全て
' &H1  : DEFAULT
' &H2  : IMAGE
' &H4  : CONTROL
' &H8  : TABLE
' &H10 : TEXTSELECT
' &H20 : ANCHOR
' &H40 : UNKNOWN

' 画面ありがどうか
bIsGUI = True
' //////////////////////////////////////////////////////////



' Csript.exe で実行を強制
Crun

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

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

strInstallPath1 = "c:\laylaClass"
strInstallPath2 = "c:\laylaClass\menuex"
strInstallPath3 = "c:\laylaClass\menuex\" & 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

SMTPServer = InputBox( "SMTPサーバー", strProgName, "サーバー名:587" )
MailTo = InputBox( "宛先", strProgName )
MailFrom = InputBox( "差出人", strProgName )
MailSubject = InputBox( "Subject(固定)",strProgName, "ブラウザのデータ" )

' ******** ●ここを変更● ********
strHtml = GetInline("MenuExt")
strHtml = Replace( strHtml, "$REGNAME", strRegName )
strHtml = Replace( strHtml, "$SMTPServer", SMTPServer )
strHtml = Replace( strHtml, "$MailTo", MailTo )
strHtml = Replace( strHtml, "$MailFrom", MailFrom )
strHtml = Replace( strHtml, "$MailSubject", MailSubject )
Call PutTextFile( strInstallPath3, strHtml )

' レジストリ処理用オブジェクト作成
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[
<SCRIPT language="VBScript">

	SMTPServer	= "$SMTPServer"
	MailTo		= "$MailTo"
	MailFrom	= "$MailFrom"
	MailSubject	= "$MailSubject"

	Dim WshShell,RegName,strLocation,obj,doc

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

	' *************************************************
	' ウインドウサイズ
	' *************************************************
	window.dialogWidth = "800px"
	window.dialogHeight = "600px"

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

	strLocation = external.menuArguments.location

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

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">
<STYLE type="text/css">
* {
	font-size:12px;
}
body {
	margin:0;
}
</STYLE>

<SCRIPT language="VBScript">

	' 関数定義用
Function SendMailBasp21()

	Dim Basp

	Set Basp = CreateObject( "Basp21" )

	MailBody = document.getElementsByName("text")(0).value

	ErrMessage = Basp.SendMail( _
		SMTPServer, _
		MailTo, _
		MailFrom, _
		MailSubject, _
		MailBody, _
		"" _
	)

	if ErrMessage <> "" then
		alert(ErrMessage & "　　　")
	else
		alert("メールを送信しました　　　")
	end if


End Function


</SCRIPT>
<base target="_self">
</head>
<BODY>

<TEXTAREA
	name="text"
	style='width:790px;height:550px;'
></TEXTAREA>
<INPUT
	type="button"
	value="送信"
	onClick='Call SendMailBasp21()'
><br>
</FORM>

</BODY>
</html>
<SCRIPT for=window event=onload language="VBScript">

	' onload 処理
	Set doc = obj.document

	set objTextArea = doc.selection
	set objTextRange = objTextArea.createRange( )
	on error resume next
	strData = objTextRange.text
	nLen = Len( strData )
	on error goto 0

	if nLen <> 0 then
		document.getElementsByName("text")(0).value = strData
	else
		strTag = obj.tagName
		if UCase( strTag ) = "A" then
			strWork = obj.innerText
			strWork = strWork & vbCrLf & obj.href
			document.getElementsByName("text")(0).value = strWork
		else
			document.getElementsByName("text")(0).value = obj.innerText
		end if
	end if

</SCRIPT>
>
</RESOURCE>

</JOB>
このアーティクルの参照用URLをクリップボードにコピー メンテナンス
カーソル下のテキストを CDO.Message でメール送信 ( No.3 )
日時： 2018/02/06 19:12
名前： lightbox
拡張子:
<JOB>
<COMMENT>
************************************************************
IE 拡張メニューインストーラ

■カーソル下のテキストを CDO.Message でメール送信

　　 CDO.Message は、Windows 標準のメール用コンポーネントです

　　インストール時に以下の情報を入力する必要があります。
　　( 何度でもインストールしなおせます )
　　一度インストールしたら、直接
　�またはIPアドレス
　　2) 宛先
　　3) 差出人
　　4) メールのタイトル

------------------------------------------------------------

　　1) カーソル下のテキストを取得します
　　2) 選択状態のテキストがあれば、それを取得します
　　3) リンクの場合は、テキストと URL を取得します
　　4) HTML タグによっては( PRE など ) その範囲内のテキスト
　　　 を取得します

■著作権その他

このプログラムはフリーです。どうぞ自由に御使用ください。
著作権は作者である私(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	= "ブラウザの情報をメール(CDO.Message)で送る"
' インストールファイル名( 拡張子は .htm となる )
strProgFile	= "send_mail_text_CDOMessage"

' メニューとウインドウのタイトルに表示する文字列
' レジストリに登録するのでユニークである必要があります
strRegName	= "－★ブラウザの情報をメール(CDO.Message)で送る"
' 対象となるコンンテンツ
nTargetType 	= &H3F
' &H3F : UNKNOWNを除く全て
' &H1  : DEFAULT
' &H2  : IMAGE
' &H4  : CONTROL
' &H8  : TABLE
' &H10 : TEXTSELECT
' &H20 : ANCHOR
' &H40 : UNKNOWN

' 画面ありがどうか
bIsGUI = True
' //////////////////////////////////////////////////////////



' Csript.exe で実行を強制
' Crun

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

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

strInstallPath1 = "c:\laylaClass"
strInstallPath2 = "c:\laylaClass\menuex"
strInstallPath3 = "c:\laylaClass\menuex\" & strProgFile & ".htm"

SMTPServer = InputBox( "SMTPサーバー", strProgName, "smtp.gmail.com:465" )
MailTo = InputBox( "宛先", strProgName )
MailFrom = InputBox( "差出人", strProgName, "username@gmail.com:username:パスワード" )
MailSubject = InputBox( "Subject(固定)",strProgName, "ブラウザのデータ" )

' ******** ●ここを変更● ********
strHtml = GetInline("MenuExt")
strHtml = Replace( strHtml, "$REGNAME", strRegName )
strHtml = Replace( strHtml, "$SMTPServer", SMTPServer )
strHtml = Replace( strHtml, "$MailTo", MailTo )
strHtml = Replace( strHtml, "$MailFrom", MailFrom )
strHtml = Replace( strHtml, "$MailSubject", MailSubject )
Call PutTextFile( strInstallPath3, strHtml )

' レジストリ処理用オブジェクト作成
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 "処理が終了しました"

Wscript.Quit

</SCRIPT>

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

	SMTPServer	= "$SMTPServer"
	MailTo		= "$MailTo"
	MailFrom	= "$MailFrom"
	MailSubject	= "$MailSubject"

	Dim WshShell,RegName,strLocation,obj,doc

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

	' *************************************************
	' ウインドウサイズ
	' *************************************************
	window.dialogWidth = "800px"
	window.dialogHeight = "600px"

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

	strLocation = external.menuArguments.document.URL

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

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">
<STYLE type="text/css">
* {
	font-size:12px;
}
body {
	margin:0;
}
</STYLE>

<SCRIPT language="VBScript">

	' 関数定義用
Function SendMailCDOMessage()

	Dim Cdo

	Set Cdo = CreateObject("CDO.Message")

	aAuth = Split( MailFrom, ":" )
	Cdo.Configuration.Fields.Item _
	 ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
	Cdo.Configuration.Fields.Item _
	 ("http://schemas.microsoft.com/cdo/configuration/sendusername") = aAuth(1)
	Cdo.Configuration.Fields.Item _ 
	 ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = aAuth(2)

	Cdo.From = aAuth(0)

	Cdo.To		= MailTo
	Cdo.Subject	= MailSubject
	Cdo.Textbody	= document.getElementsByName("text")(0).value

	Cdo.Configuration.Fields.Item _
	 ("http://schemas.microsoft.com/cdo/configuration/sendusing") = _
		2

	sv = Split(SMTPServer,":")

	Cdo.Configuration.Fields.Item _
	 ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
		sv(0)
	Cdo.Configuration.Fields.Item _
	 ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = _
		sv(1)
	Cdo.Configuration.Fields.Item _
	 ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = true

	Cdo.Configuration.Fields.Update

	on error resume next
	Cdo.Send
	if Err.Number <> 0 then
		alert(Err.Description & "　　　")
	else
		alert("メールを送信しました　　　")
	end if
	on error goto 0
	window.close()

End Function


</SCRIPT>
<base target="_self">
</head>
<BODY>

<TEXTAREA
	name="text"
	style='width:790px;height:550px;'
></TEXTAREA>
<INPUT
	type="button"
	value="送信"
	onClick='Call SendMailCDOMessage()'
><br>
</FORM>

</BODY>
</html>
<SCRIPT for=window event=onload language="VBScript">

	' onload 処理
	Set doc = obj.document

	set objTextArea = doc.selection
	set objTextRange = objTextArea.createRange( )
	on error resume next
	strData = objTextRange.text
	nLen = Len( strData )
	on error goto 0

	if nLen <> 0 then
		document.getElementsByName("text")(0).value = strData
	else
		strTag = obj.tagName
		if UCase( strTag ) = "A" then
			strWork = obj.innerText
			strWork = strWork & vbCrLf & obj.href
			document.getElementsByName("text")(0).value = strWork
		else
			document.getElementsByName("text")(0).value = obj.innerText
		end if
	end if

</SCRIPT>
]]>
</RESOURCE>

</JOB>
このアーティクルの参照用URLをクリップボードにコピー メンテナンス