かなり前に作ったものなので、IEの仕様変更が理由で動かなくなっていた部分がありました。今回修正とともに、Gmail に最適化しました。ダウンロード Gmail を基本にデフォルト表示していますが、SSL/465 でクライアント設定できるメールサービスなら使えるはずです。 パスワードをソースに埋め込む事になるので、自宅でのみの使用が推奨されます。 内容を変更したい場合は、再度インストールを行います。
1) カーソル下のテキストを取得します 2) 選択状態のテキストがあれば、それを取得します 3) リンクの場合は、テキストと URL を取得します 4) HTML タグによっては( PRE など ) その範囲内のテキスト を取得します
<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://homepage2.nifty.com/lightbox/laylaClass.vbs">
</SCRIPT>
<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************
Call laylaFunctionTarget( "http://homepage2.nifty.com/lightbox/" )
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>
更新履歴 2009-04-07 : 初回投稿 2013-07-26 : 動作確認とブログ本文を大幅に変更
※ エキスパートモードで表示しています
アーカイブとカテゴリページはこのように簡単に設定できますが、タグページは HTML 設定を直接変更して、以下の『タグページでのみ表示される内容』の記述方法で設定する必要があります
