VBS通过注册表增加新功能

安装脚本.vbs

‘AddExplorerOptions.vbs
‘Add Options in View - Folder Options - View - Advanced
‘
‘Serenity Macros   http://www.angelfire.com/biz/serenitymacros
‘David Candy  davidc@sia.net.au
‘
‘stLancer汉化简体中文版 stLancer@hotmail.com
‘http://www.megadown.com

On Error Resume Next
strExplain="AddExplorerOptions.vbs在查看－文件夹选项－查看－高级设置里面增加了很多功能。" &vbCRLF & vbCRLF & "下列文件在运行本程序时必须处于同一文件夹," &vbCRLF & vbCRLF & "Options.reg"  &vbCRLF & vbCRLF & "继续安装么？"
strTitle="安装高级查看菜单选项程序－stLancer汉化版"
HaveError=""
Dim Sh
Set Sh = WScript.CreateObject("WScript.Shell")
ReportErrors "Creating Shell"
Sh.RegWrite "HKLM/Software/Microsoft/Windows/CurrentVersion/App Paths/" & Wscript.ScriptName & "/", Chr(34) & Wscript.ScriptFullName & Chr(34)
Sh.RegWrite "HKLM/Software/Microsoft/Windows/CurrentVersion/App Paths/" & Left(Wscript.ScriptName, Len(Wscript.ScriptName)-3) & "exe" & "/", Chr(34) & Wscript.ScriptFullName & Chr(34)
ReportErrors "Updating App Paths"
If MsgBox(strExplain ,vbYesNo + vbQuestion, strTitle) =6 Then

sh.Run "regedit /s " & Chr(34) & "Explorer Options.reg" & Chr(34)
‘ sh.Run Chr(34) & "Explorer Options.reg" & Chr(34)
 If err.number<>0 then HaveError="Yes"
 ReportErrors "安装本程序"
 If HaveError="Yes" Then
  MsgBox "请确认‘Options.reg‘文件放在本程序同一文件夹下！", vbOKOnly + vbCritical, strTitle
 Else
  Msgbox "安装成功！",vbOKOnly + vbInformation, strTitle
 End If
End If

VisitSerenity

Sub ReportErrors(strModuleName)
 If err.number<>0 then Msgbox "发生了未知错误." & vbCRLF & vbCRLF & "错误提示：" & vbCRLF & vbCRLF & "脚本名称" & vbTab & Wscript.ScriptFullName & vbCRLF & "模块：" & vbtab & vbTab & strModuleName & vbCRLF & "错误代码：" & vbTab & err.number & vbCRLF & "说明：" & vbTab & err.description, vbCritical + vbOKOnly, "未知错误"
 Err.clear
End Sub

Sub VisitSerenity
 If MsgBox("本程序由Serenity Macros制作，stLancer汉化" & vbCRLF & vbCRLF & "你是否愿意访问一下我们的网站?", vbQuestion + vbYesNo , "安装完成") =6 Then
  sh.Run "http://www.megadown.com"
 End If
End Sub