定制全新的Win2000另类“位置条”
三、定制过程自动化
下面介绍一个modifyPlaces.vbs脚本，这是一个自动读取和写入位置信息的程序。在Win2K命令窗口下，执行“CScript modifyPlaces.vbs”或“WScript modifyPlaces.vbs”即可启动该程序，参见图二。程序首先询问你想要修改的位置编号。如果输入0到4之间的数字，程序继续，点击“是”用路径指定文件夹，点击“否”用ID数字指定文件夹。点击“是”之后，程序要求你输入一个完整的路径名，完成后，程序将创建一个REG_SZ注册键。如果选择了“否”，程序要求输入一个系统文件夹ID，完成后，程序创建一个REG_DWord子键。指定一个位置之后，程序允许你继续指定其他的位置。
图二：定制位置条
' 常量
const APP_TITLE = "设置“打开”对话框的位置条"
const REG_PLACESBAR = "HKCUSoftwareMicrosoftWindowsCurrentVersionPolicIEsComDlg32Placesbar"
Dim place ' 位置编号
Dim canContinue ' 逻辑开关' 获取待设置的位置编号
canContinue = True
While canContinue
place = InputBox("输入位置编号 (0到4)", APP_TITLE, 0)
' 点击了“取消”按钮...
If place = "" Then
WScript.Quit
End If
If place > 4 Then
MsgBox "位置编号错误，请指定0-4之间的位置编号!", 16, APP_TITLE
Else
' 位置编号合法，从注册表读取信息
ChangePlace place
End If
Wend
' 修改指定的位置
Sub ChangePlace (place)
Dim shell, curPath, buf, rc, newPath, theType
Set shell = CreateObject("WScript.Shell")
On Error Resume Next
curPath = shell.RegRead(REG_PLACESBAR & "Place" & place)
On Error Goto 0
' 默认值
If curPath = "" Then curPath = "默认值"
buf = ""
buf = buf & "位置" & place & "当前被设置为" & _
Chr(34) & curPath & Chr(34) & vbCrLf & vbCrLf & _
"点击“是”指定一个普通文件夹" & vbCrLf & _
"点击“否”指定一个系统文件夹" & vbCrLf & _
"点击“取消”退出程序"
rc = MsgBox(buf, 3, APP_TITLE)
' YES=6, NO=7, CANCEL=2
If rc = vbCancel Then Exit Sub
' 修改位置
Select Case rc
Case vbYes
newPath = InputBox("输入新的文件夹路径", APP_TITLE, curPath)
If newPath = "" Then Exit Sub
theType = "REG_SZ"
Case vbNo
buf = ""
buf = buf & "选择新的文件夹." & vbCrLf & vbCrLf & _
"5 - 我的文档" & vbCrLf & _
"6 - 收藏" & vbCrLf & _
"17 - 我的电脑" & vbCrLf & _
"18 - 网上邻居" & vbCrLf & _
"36 - Windows系统目录" & vbCrLf & _
"34 - 历史"
newPath = InputBox(buf, APP_TITLE, curPath)
If newPath = "" Then Exit Sub
theType = "REG_DWORD"
End Select
shell.RegWrite REG_PLACESBAR & "Place" & place, newPath, theType
End Sub
const APP_TITLE = "设置“打开”对话框的位置条"
const REG_PLACESBAR = "HKCUSoftwareMicrosoftWindowsCurrentVersionPolicIEsComDlg32Placesbar"
Dim place ' 位置编号
Dim canContinue ' 逻辑开关' 获取待设置的位置编号
canContinue = True
While canContinue
place = InputBox("输入位置编号 (0到4)", APP_TITLE, 0)
' 点击了“取消”按钮...
If place = "" Then
WScript.Quit
End If
If place > 4 Then
MsgBox "位置编号错误，请指定0-4之间的位置编号!", 16, APP_TITLE
Else
' 位置编号合法，从注册表读取信息
ChangePlace place
End If
Wend
' 修改指定的位置
Sub ChangePlace (place)
Dim shell, curPath, buf, rc, newPath, theType
Set shell = CreateObject("WScript.Shell")
On Error Resume Next
curPath = shell.RegRead(REG_PLACESBAR & "Place" & place)
On Error Goto 0
' 默认值
If curPath = "" Then curPath = "默认值"
buf = ""
buf = buf & "位置" & place & "当前被设置为" & _
Chr(34) & curPath & Chr(34) & vbCrLf & vbCrLf & _
"点击“是”指定一个普通文件夹" & vbCrLf & _
"点击“否”指定一个系统文件夹" & vbCrLf & _
"点击“取消”退出程序"
rc = MsgBox(buf, 3, APP_TITLE)
' YES=6, NO=7, CANCEL=2
If rc = vbCancel Then Exit Sub
' 修改位置
Select Case rc
Case vbYes
newPath = InputBox("输入新的文件夹路径", APP_TITLE, curPath)
If newPath = "" Then Exit Sub
theType = "REG_SZ"
Case vbNo
buf = ""
buf = buf & "选择新的文件夹." & vbCrLf & vbCrLf & _
"5 - 我的文档" & vbCrLf & _
"6 - 收藏" & vbCrLf & _
"17 - 我的电脑" & vbCrLf & _
"18 - 网上邻居" & vbCrLf & _
"36 - Windows系统目录" & vbCrLf & _
"34 - 历史"
newPath = InputBox(buf, APP_TITLE, curPath)
If newPath = "" Then Exit Sub
theType = "REG_DWORD"
End Select
shell.RegWrite REG_PLACESBAR & "Place" & place, newPath, theType
End Sub
标签：
