Chinaunix首页 | 论坛 | 博客
  • 博客访问: 63949
  • 博文数量: 21
  • 博客积分: 1415
  • 博客等级: 上尉
  • 技术积分: 345
  • 用 户 组: 普通用户
  • 注册时间: 2006-10-16 17:35
文章分类

全部博文(21)

文章存档

2011年(1)

2010年(2)

2009年(14)

2008年(4)

我的朋友
最近访客

分类:

2009-06-22 12:04:57

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)
阅读(581) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~