ソース掲示板

メンテナンス
対象スレッド	件名：カーソル下のテキストを CDO.Message でメール送信名前： lightbox
処理選択
パスワード
件名
カーソル下のテキストを CDO.Message でメール送信
名前
lightbox
@DIV
<JOB>
<COMMENT>
************************************************************
IE 拡張メニューインストーラ

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

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

　　インストール時に以下の情報を入力する必要があります。
　　( 何度でもインストールしなおせます )
　　一度インストールしたら、直接
　　C:\laylaClass\menuex\send_mail_text_CDOMessage.wsf
　　を変更しても同じです

　　1) ホスト名(または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>
@END