中国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后再导入就好了。

其实是我的失误。注明一下就好了。

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