中国DOS联盟

-- 联合DOS 推动DOS 发展DOS --

联盟域名：www.cn-dos.net 论坛域名：www.cn-dos.net/forum
DOS，代表着自由开放与发展，我们努力起来，学习FreeDOS和Linux的自由开放与GNU精神，共同创造和发展美好的自由与GNU GPL世界吧！

游客: 注册 | 登录 | 命令行 | 会员 | 搜索 | 上传 | 帮助 »

中国DOS联盟论坛 » DOS批处理 & 脚本技术（批处理室） » 管理浏览器地址栏下拉列表→VBS版

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『楼主』: 管理浏览器地址栏下拉列表→VBS版

前段时间，忘了是哪位问是否可以根据需要编辑IE地址栏里的内容，当时没时间写，只是觉的思路不错，今天试试果然又是个懒人的好东东。把几个常用网址导入/导出后将自动完成(自动记忆)一关，呵呵，比收藏夹还方便，也不显得凌乱。

注：从txt文件导入地址栏会清空当前地址栏并用txt中的内容覆盖，因此首次使用时可先选择导出地址栏到txt文件，编辑txt文件后再导入，就不会出现地址栏被清空的现象了。

Manage_TypedURLs.rar

slore 还原源码很成功，如果可以连随机大小写也解决了就完美了

Quote:

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

此帖被 +13 点积分

点击查看详情

好多菩提树，好多明镜台。本来好多物，好多的尘埃。

2007-6-3 03:20

ccwan
金牌会员

积分 2725
发帖 1160
注册 2006-9-23
来自河北廊坊
状态离线

『第 2 楼』:

谢谢分享。

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

2007-6-3 08:24

slore
铂金会员

积分 5212
发帖 2478
注册 2007-2-8
状态离线

『第 3 楼』:

Quote:

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

2007-6-3 10:12

slore
铂金会员

积分 5212
发帖 2478
注册 2007-2-8
状态离线

『第 4 楼』:

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

2007-6-3 10:33

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『第 5 楼』:

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

好多菩提树，好多明镜台。本来好多物，好多的尘埃。

2007-6-3 10:40

slore
铂金会员

积分 5212
发帖 2478
注册 2007-2-8
状态离线

『第 6 楼』:

呵呵，刚好还修改了个BUG……

reg "xx",""
原来会把""当转义……然后把后面出现的"的之后的cut掉……很郁闷……

现在好了，不过之前的那些问题还没有时间解决..我先发临时用吧。
临时的这个还是可以用的。

2007-6-3 10:47

slore
铂金会员

积分 5212
发帖 2478
注册 2007-2-8
状态离线

『第 7 楼』: HightLight

高亮VBS脚本

下载地址

2007-6-3 10:51

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『第 8 楼』:

太高兴了谢谢！

好多菩提树，好多明镜台。本来好多物，好多的尘埃。

2007-6-3 10:57

jmz573515
银牌会员

积分 1212
发帖 464
注册 2006-12-13
状态离线

『第 9 楼』:

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

2007-6-3 12:03

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『第 10 楼』:

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

好多菩提树，好多明镜台。本来好多物，好多的尘埃。

2007-6-3 12:11

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『第 11 楼』:

Quote:

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

如果把“列表文件”改为“文本文件”可能就易理解了，我的失误。

另，原来那个是你问的啊，本想搜类似代码，只找到一个：如何枚举IE地址栏里的内容，并且根据要求修改？（VBS）

好多菩提树，好多明镜台。本来好多物，好多的尘埃。

2007-6-3 12:27

jmz573515
银牌会员

积分 1212
发帖 464
注册 2006-12-13
状态离线

『第 12 楼』:

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

2007-6-3 12:49

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『第 13 楼』:

呵呵导入时是全部清空后再用txt里的覆盖，你如果先导出到txt文件，然后编辑txt后再导入就好了。

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

好多菩提树，好多明镜台。本来好多物，好多的尘埃。

2007-6-3 12:55

jmz573515
银牌会员

积分 1212
发帖 464
注册 2006-12-13
状态离线

『第 14 楼』:

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

2007-6-3 14:27

请注意：您目前尚未注册或登录，请您注册或登录以使用论坛的各项功能，例如发表和回复帖子等。

可打印版本 | 推荐给朋友 | 订阅主题 | 收藏主题

论坛跳转: