WSH Memo 2

send page
Internet Explorerの右クリックメニューに"このページを送る"を追加します。
知人と共有したいページがある場合、選択することでそのページのURLをメールで伝えることができます。
'sendpage_inst.vbs

url="http://ut.netfirms.com/cgi-bin/sndpg.cgi"

i=MsgBox("このスクリプトはIEの右メニューに、'このページを送る'を追加するものです",vbOKCancel+vbInformation,"sendpage インストール")
if i=vbCancel then WScript.Quit
name=InputBox("あなたの名前")
email=InputBox("あなたのE-Mail")

q=chr(34)
set F=WScript.CreateObject("Scripting.FileSystemObject")
fi=F.GetParentFolderName(F.GetAbsolutePathName("sendpage_inst.vbs"))+"\sendpage.html"
fj=F.GetParentFolderName(F.GetAbsolutePathName("sendpage_inst.vbs"))+"\sendpfrm.html"

set wf=F.CreateTextFile(fi,true)
wf.WriteLine "<script language=VBScript>"
wf.WriteLine "set w1=window.open("+q+q+","+q+"snd"+q+","+q+"toolbar=0,location=0,status=0,menubar=0,scrollbars=0,resizable=0,width=550,height=220"+q+")"
wf.WriteLine "ht="+q+q
wf.WriteLine "w1.document.write("+q+"<META HTTP-EQUIV=Refresh CONTENT='0;URL=sendpfrm.html?"+q+"+external.menuArguments.document.Url+"+q+"'>"+q+")"
wf.WriteLine "w1.document.close"
wf.WriteLine "</script>"
wf.Close
set wf=F.CreateTextFile(fj,true)
wf.WriteLine "<HTML><HEAD><TITLE>send page</TITLE></HEAD><BODY BGCOLOR=#FFFFFF>"
wf.WriteLine "<FORM NAME=f1 METHOD=POST ACTION="+url+">"
wf.WriteLine "<CENTER><B><FONT COLOR=#FF8000>このページを送る</FONT></B><BR>"
wf.WriteLine "<TABLE><TD><TABLE><TR><TD><FONT SIZE=2>あなたの名前</FONT></TD><TD><INPUT TYPE=TEXT SIZE=20 NAME=name VALUE='"+name+"'></TD></TR>"
wf.WriteLine "<TR><TD><FONT SIZE=2>あなたのメール</FONT></TD><TD><INPUT TYPE=TEXT SIZE=20 NAME=email VALUE='"+email+"'></TD></TR>"
wf.WriteLine "<TR><TD><FONT SIZE=2>相手の名前</FONT></TD><TD><INPUT TYPE=TEXT SIZE=20 NAME=frnam></TD></TR>"
wf.WriteLine "<TR><TD><FONT SIZE=2>相手のメール</FONT></TD><TD><INPUT TYPE=TEXT SIZE=20 NAME=frmai></TD></TR></TABLE>"
wf.WriteLine "</TD><TD><FONT SIZE=2>コメント</FONT><BR><TEXTAREA NAME=comm ROWS=5 COLS=30></TEXTAREA><BR>"
wf.WriteLine "<script language=VBScript>document.write("+q+"URL <INPUT TYPE=INPUT NAME=url VALUE="+q+"+Mid(document.location.href,"+CStr(Len(fj)+10)+")+"+q+" SIZE=34><BR>"+q+")</SCRIPT>"
wf.WriteLine "<BR><INPUT TYPE=SUBMIT VALUE=send> <INPUT TYPE=RESET VALUE=reset></TD></TABLE></CENTER></BODY></HTML>"
wf.Close

set W=WScript.CreateObject("WScript.Shell")
W.RegWrite "HKCU\Software\Microsoft\Internet Explorer\MenuExt\このページを送る\",fi
MsgBox "正常に終了した",vbOKOnly,"sendpage インストール"
download sendpage_inst.vbs
IE5でのみ動作確認済み。紫色の部分がIE用スクリプトの参考になるでしょう。
そのVBSのあるフォルダの実行ファイルを実行(VBS)
' run.vbs

set F=WScript.CreateObject("Scripting.FileSystemObject")
set a=WScript.CreateObject("WScript.Shell")
a.run F.GetAbsolutePathName("????.exe")+" argument"


コピー(VBS)
' copy1.vbs

dim A,F,fo
set A=WScript.Arguments
if A.Count=0 then WScript.Quit
set F=WScript.CreateObject("Scripting.FileSystemObject")

fo=InputBox(A(0)+"をどこにコピーしますか?"+chr(13)+"(語尾に\を入れるな)")
if fo="" then WScript.Quit

F.CopyFile A(0),fo+"\\"+F.GetFileName(A(0))

戻る