中国DOS联盟

前段时间，忘了是哪位问是否可以根据需要编辑IE地址栏里的内容，当时没时间写，只是觉的思路不错，今天试试果然又是个懒人的好东东。把几个常用网址导入/导出后将自动完成(自动记忆)一关，呵呵，比收藏夹还方便，也不显得凌乱。 注：从txt文件导入地址栏会清空当前地址栏并用txt中的内容覆盖，因此首次使用时可先选择导出地址栏到txt文件，编辑txt文件后再导入，就不会出现地址栏被清空的现象了。 Manage_TypedURLs.rar slore 还原源码很成功，如果可以连随机大小写也解决了就完美了

'''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

　 [ Last edited by baomaboy on 2008-3-24 at 11:53 PM ]

谢谢分享。

三人行，必有吾师焉。 学然后知不足，教然后知困，然后能自强也。

'''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

晕，引用了还不算是我写的＝。＝（提示字符小于1） [ Last edited by slore on 2007-6-3 at 10:49 AM ]

就是郁闷啊，你随机换行，还随机给字符串加乱七八糟的0长度字符串变量…… 唉～随机是不好还原的……

代码着色真是不错，看着舒服，不知兄是否完成了，期待。。。。

呵呵，刚好还修改了个BUG…… reg "xx","" 原来会把""当转义……然后把后面出现的"的之后的cut掉……很郁闷…… 现在好了，不过之前的那些问题还没有时间解决..我先发临时用吧。 临时的这个还是可以用的。

高亮VBS脚本 下载地址

太高兴了 谢谢！

没弄明白你的1，2，3，4具体含义...

就是四个功能， 1.导出当前地址栏内容到txt文件 2.从txt文件导入到地址栏(注册表) 3.手工编辑txt文件 4.动态判断自动记忆状态，并可更改状态。

Originally posted by jmz573515 at 2007-6-3 12:03: 没弄明白你的1，2，3，4具体含义...

如果把“列表文件”改为“文本文件”可能就易理解了，我的失误。 另，原来那个是你问的啊，本想搜类似代码，只找到一个：如何枚举IE地址栏里的内容，并且根据要求修改？（VBS）

哈哈，是我问的，我的意思是想怎么才能方便删除IE地址栏里的内容，不过你这个脚本好像是全部清空了...（不过还是非常感谢你！）

呵呵 导入时是全部清空后再用txt里的覆盖，你如果先导出到txt文件，然后编辑txt后再导入就好了。 其实是我的失误。注明一下就好了。

终于弄明白是怎么回事了，不错！