baomaboy
银牌会员
积分 1513
发帖 554
注册 2005-12-30
状态 离线
|
『第
7 楼』:
ÿ
| Quote: | '*****************************************************************************
' FileName: SaveText.VBS
' Author: baomaboy
' Abstract: 在浏览器右键菜单中添加“保存为文本文件”
'*****************************************************************************
Dim WshSHell,FSO
On Error Resume Next
Set WshSHell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WinVer = WshSHell.Environment("Process")
Set Args = WScript.Arguments
CloseTime = 5
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
FilePath = FSO.GetParentFolderName(FileFullName)
InsPath = FSO.GetSpecialFolder(1)'''0=windows,1=system32,2=user-Temp,
InsFullName = FSO.BuildPath(InsPath ,FileName)
LnkPathAll = WshShell.SpecialFolders("MyDocuments")'''括号中输入文件夹名称(有空格要删除)，可以取得任意系统的内置文件夹路径。
OtherFileName="savetext.htm"
OtherFilePath=FSO.BuildPath(InsPath ,OtherFileName)
Copyright="玲珑科技"
QQ="QQ:25926183"
Email="Email:25926183@qq.com"
InsTitle="保存为文本文件"
InsAnswer="保存为文本文件"
RegPath1="HKCU\Software\Microsoft\Internet Explorer\MenuExt\保存为TXT文件(&K)\"
RegValue1=OtherFilePath
RegForm1="REG_SZ"
RegPath2="HKCU\Software\Microsoft\Internet Explorer\MenuExt\保存为TXT文件(&K)\contexts"
RegValue2="243"
RegForm2="REG_DWORD"
intAnswer = MsgBox("【是】将“"+ InsAnswer +"”加入到浏览器右键菜单，"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从浏览器右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - by baomaboy")
If intAnswer = vbYes Then
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "如果点取消则默认保存到："+chr(10)+chr(10)+FSO.BuildPath(LnkPathAll,"TXT_BOOK"), NO_OPTIONS)
If Not objFolder is Nothing then
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
LnkPathAll=Replace(objPath,"\","\\")
Call Install
end if
if (FSO.FolderExists(FSO.BuildPath(LnkPathAll ,"TXT_BOOK"))) Then
LnkPathAll=Replace(FSO.BuildPath(LnkPathAll,"TXT_BOOK"),"\","\\")
Call Install
Else
Set NewFile = FSO.CreateFolder(FSO.BuildPath(LnkPathAll ,"TXT_BOOK"))
LnkPathAll=Replace(FSO.BuildPath(LnkPathAll,"TXT_BOOK"),"\","\\")
Call Install
end if
End if
If intAnswer = vbNo Then
WshSHell.RegDelete RegPath2
WshSHell.RegDelete RegPath1
FSO.DeleteFile OtherFilePath
WshSHell.popup _
"删除执行文件："+chr(10)+OtherFilePath+chr(10)+chr(10)+ _
"删除注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "卸载成功 - "+ InsTitle +" - by baomaboy", 0 + 64
end if
If intAnswer = vbCancel Then
end if
Sub Install()
Set NewFile = FSO.CreateTextFile(OtherFilePath, True)
NewFile.WriteLine("<SCRIPT LANGUAGE="+chr(34)+"JavaScript"+chr(34)+">")
NewFile.WriteLine("var oWindow=window.external.menuArguments;")
NewFile.WriteLine("var oDocument=oWindow.document;")
NewFile.WriteLine("var oSelect=oDocument.selection;")
NewFile.WriteLine("var oSelectRange=oSelect.createRange();")
NewFile.WriteLine("var selectText=oSelectRange.text;")
NewFile.WriteLine("var tFilename;")
NewFile.WriteLine("if (selectText.length==0||!/\s/.test(selectText)) {")
NewFile.WriteLine(" alert("+chr(34)+"请先选择一段文字!"+chr(34)+");}")
NewFile.WriteLine("else {")
NewFile.WriteLine(" selectText=selectText.replace(/^(\s+)(\s+)/,"+chr(34)+"$2"+chr(34)+");")
NewFile.WriteLine(" tFilename=/\n/.test(selectText) ? selectText.substring(0,selectText.search(/\n/)):selectText;")
NewFile.WriteLine(" tFilename=tFilename.length > 18 ? tFilename.substring(0,10)+"+chr(34)+"..."+chr(34)+"+tFilename.substring(tFilename.length-6,tFilename.length):tFilename;")
NewFile.WriteLine(" tFilename=tFilename.replace(/\n|\r|\f/g,"+chr(34)+chr(34)+");")
NewFile.WriteLine(" var errorChar=/(\\|\/|:|\*|\?|"+chr(34)+"|\<|\>|\|)/")
NewFile.WriteLine(" while(errorChar.test(tFilename)||tFilename==null) {")
NewFile.WriteLine(" tFilename=prompt("+chr(34)+"由于所选文字中包含\/:*?<>等不能作为文件名的字符，请重新输入要存储的文件名(不需要添加扩展名)."+chr(34)+",tFilename);}")
NewFile.WriteLine(" var fso,fl,fname;")
NewFile.WriteLine(" fso=new ActiveXObject("+chr(34)+"Scripting.FileSystemObject"+chr(34)+");")
NewFile.WriteLine(" fname="+chr(34)+ LnkPathAll + "\\"+chr(34)+"+tFilename+ " +chr(34)+".txt"+chr(34)+";")
NewFile.WriteLine(" if (fso.FileExists(fname)){")
NewFile.WriteLine(" if (confirm(fname+ "+chr(34)+"已经存在，要追加内容吗?"+chr(34)+")){")
NewFile.WriteLine(" fl=fso.OpenTextFile(fname,8,true);")
NewFile.WriteLine(" fl.WriteLine("""");")
NewFile.WriteLine(" fl.WriteLine(""*********************************************"");")
NewFile.WriteLine(" fl.Write(selectText);")
NewFile.WriteLine(" fl.Close();")
NewFile.WriteLine(" alert(fname+"+chr(34)+" 保存成功! "+chr(34)+");")
NewFile.WriteLine(" }")
NewFile.WriteLine(" }")
NewFile.WriteLine(" else {")
NewFile.WriteLine(" fl=fso.CreateTextFile(fname,true);")
NewFile.WriteLine(" fl.Write(selectText);")
NewFile.WriteLine(" fl.Close();")
NewFile.WriteLine(" alert(fname+"+chr(34)+" 保存成功! "+chr(34)+");")
NewFile.WriteLine(" }")
NewFile.WriteLine(" }")
NewFile.WriteLine("</SCRIPT>")
NewFile.Close
WshSHell.RegWrite RegPath1,RegValue1,RegForm1
WshSHell.RegWrite RegPath2,RegValue2,RegForm2
WshSHell.popup _
"添加执行文件："+chr(10)+OtherFilePath+chr(10)+chr(10)+ _
"添加注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+chr(10)+ _
"添加保存目录："+chr(10)+ Replace(LnkPathAll,"\\","\") +chr(10)+chr(10)+ _
"请注意："+chr(10)+"要更改文件的保存路径请重新运行此安装程序！"+chr(10)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "安装成功 - "+ InsTitle +" - by baomaboy", 0 + 64
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)
End Sub
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0) |
|
ÿ
[ Last edited by baomaboy on 2008-3-24 at 10:10 PM ]
|
|
