'''Manage_TypedURLs.VBS by baomaboy
'''注意生效条件,如浏览器关闭打开新窗口。
Dim WshSHell,FSO
on Error Resume Next
Set WshSHell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
CloseTime = 5
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
FilePath = FSO.GetParentFolderName(FileFullName)
InsPath = FSO.GetSpecialFolder(1)
InsFullName = FSO.BuildPath(InsPath ,FileName)
URLsTxt = "URLsTxt.txt"
Copyright = "玲珑科技"
QQ = "QQ:25926183"
Email = "Email:fty1995@163.com"
InsTitle = "管理地址栏链接"
InsAnswer = "管理地址栏链接"
RegPath1 = "HKEY_CLASSES_ROOT\CLSID\{871C5380-42A0-1069-A2EA-08002B30309D}\shell\Manage_TypedURLs\"
RegValue1 = "管理地址栏(&G)"
RegForm1 = "REG_SZ"
RegPath2 = "HKEY_CLASSES_ROOT\CLSID\{871C5380-42A0-1069-A2EA-08002B30309D}\shell\Manage_TypedURLs\command\"
RegValue2 = "wscript.exe " & InsFullName
RegForm2 = "REG_SZ"
If FileFullName <> InsFullName Then
intAnswer = MsgBox("【是】将“" + InsAnswer + "”加入到桌面IE图标右键菜单," & Chr(10) & Chr(10) & "【否】将“" + InsAnswer + "”从桌面IE图标右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - " + InsTitle + " - " + Copyright)
If intAnswer = vbYes Then
WshSHell.RegWrite RegPath1,RegValue1,RegForm1
WshSHell.RegWrite RegPath2,RegValue2,RegForm2
FSO.GetFile(FileFullName).Copy(InsFullName)
WshSHell.popup _
"添加脚本文件:" + Chr(10) + InsFullName + 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 = vbNo Then
WshSHell.RegDelete RegPath2
WshSHell.RegDelete RegPath1
FSO.DeleteFile InsFullName
WshSHell.popup _
"删除脚本文件:" + Chr(10) + InsFullName + 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
Else
If (FSO.FileExists(FSO.BuildPath(InsPath,URLsTxt))) Then
Else
Set NewFile = FSO.CreateTextFile(FSO.BuildPath(InsPath,URLsTxt), True)
NewFile.WriteLine("http://hi.baidu.com/baomaboy")
NewFile.Close
End If
RegAutoSuggest = WshSHell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\AutoComplete\AutoSuggest")
If LCase(RegAutoSuggest) = "no" Then
showras = "关闭" : showexras = "开启" : exras = LCase("yes")
Else
showras = "开启" : showexras = "关闭" : exras = LCase("no")
End If
N = InputBox("当前自动记忆功能:" & showras & "。" & vbCrLf & vbCrLf & "1.导入地址栏从列表文件," & vbCrLf & vbCrLf & "2.导出地址栏到列表文件," & vbCrLf & vbCrLf & "3.编辑列表文件为地址栏," & vbCrLf & vbCrLf & "4." & showexras & "地址栏自动记忆项。","浏览器地址栏管理 — QQ:25926183","1")
If N = False Then WScript.Quit
If IsNumeric(N) = False Then
WshShell.popup Chr(10) & _
"请输入正确的编号值(输入数字型值)!" + Chr(10) & Chr(10) & _
Chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" + Chr(10) + Chr(10) + _
Chr(10) & "Copyright(C) " + Copyright + " " & QQ & " " + Email _
, CloseTime, "错误提示 - " + InsTitle + " - " + Copyright, 0 + 48
WScript.Quit(0)
Else
Select Case N
Case 1 Call URLsFormFile(LCase("inurls"))
Case 2 Call URLsFormFile(LCase("outruls"))
Case 3 Call URLsFormFile(LCase("fixtxt"))
Case 4 WshSHell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\AutoComplete\AutoSuggest", exras , RegForm1
Case Else WshShell.popup Chr(10) & _
"请输入正确的编号值(注意编号范围)!" + Chr(10) & Chr(10) & _
Chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" + Chr(10) + Chr(10) + _
Chr(10) & "Copyright(C) " + Copyright + " " & QQ & " " + Email _
, CloseTime, "错误提示 - " + InsTitle + " - " + Copyright, 0 + 48
WScript.Quit(0)
End Select
End If
End If
Set WshSHell = Nothing
Set FSO = Nothing
WScript.Quit(0)
Sub URLsFormFile(exc)
If LCase(exc) = "inurls" Then
WshSHell.RegWrite "HKCU\Software\Microsoft\Internet Explorer\TypedURLs\",""
WshSHell.RegDelete "HKCU\Software\Microsoft\Internet Explorer\TypedURLs\"
Set InR = FSO.OpenTextFile(FSO.BuildPath(InsPath,URLsTxt),1)
myweb = 0
i = 0
Do Until InR.AtEndOfStream
i = i + 1
WshSHell.RegWrite "HKCU\Software\Microsoft\Internet Explorer\TypedURLs\url" & i,InR.ReadLine
If myweb = 0 Then
If InStr(WshSHell.RegRead("HKCU\Software\Microsoft\Internet Explorer\TypedURLs\url" & i),"baomaboy") > 0 Then
myweb = 1
End If
End If
Loop
InR.Close
If myweb = 0 Then
WshSHell.RegWrite "HKCU\Software\Microsoft\Internet Explorer\TypedURLs\url" & i + 1,"http://hi.baidu.com/baomaboy"
End If
ElseIf LCase(exc) = "outruls" Then
Const HKEY_CURRENT_USER = &H80000001'''remnotecbybaomaboy
strComputer = "."
Set WshShell = WScript.CreateObject("WScript.Shell")
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
oReg.EnumValues HKEY_CURRENT_USER,"Software\Microsoft\Internet Explorer\TypedURLs", arrValueNames,arrValueTypes'''remnotecbybaomaboy
For Each strValue In arrValueNames
If Len(strValue) > 0 Then
oReg.GetStringValue HKEY_CURRENT_USER,"Software\Microsoft\Internet Explorer\TypedURLs\",strValue,strRunCommand'''remnotecbybaomaboy
If Len(strRunCommand) > 0 Then
outrulstxt = outrulstxt & strRunCommand & vbCrLf
End If
End If
Next
Set OutR = FSO.OpenTextFile(FSO.BuildPath(InsPath,URLsTxt),2,True)
OutR.Write outrulstxt
OutR.Close
ElseIf LCase(exc) = "fixtxt" Then
WshSHell.Run ("Notepad.exe " & FSO.BuildPath(InsPath,URLsTxt))
End If
End Sub |
|