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)
InsFullName = FSO.BuildPath(InsPath ,FileName)
LnkPathNT = WshSHell.SpecialFolders(2)
LnkPath9X = WshSHell.SpecialFolders(14)
LnkPathAll = WshSHell.SpecialFolders("MyDocuments")
OtherFileName="savetext.htm"
OtherFilePath=FSO.BuildPath(InsPath ,OtherFileName)
TemFileName="无标题"
TemFilePath=FSO.GetSpecialFolder(2)
Copyright=""
QQ=""
Email=""
InsTitle="保存为文本文件"
InsAnswer="保存为文本文件"
RegPath1="HKCU\Software\Microsoft\Internet Explorer\MenuExt\保存为文本文件(&K)\"
RegValue1=OtherFilePath
RegForm1="REG_SZ"
RegPath2="HKCU\Software\Microsoft\Internet Explorer\MenuExt\保存为文本文件(&K)\contexts"
RegValue2="243"
RegForm2="REG_DWORD"
intAnswer = MsgBox("【是】将“"+ InsAnswer +"”加入到浏览器右键菜单,"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从浏览器右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - "+ Copyright)
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 +" - "+ Copyright, 0 + 64
end if
If intAnswer = vbCancel Then
end if
Sub Install()
Set NewFile = FSO.CreateTextFile(OtherFilePath, True)
NewFile.WriteLine("")
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 +" - "+ Copyright, 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)
阅读(603) | 评论(0) | 转发(0) |