应空间里一个好友写的，就是包装一下subst命令，解决他所说盘符不能递增的问题。整日瞎忙没时间 拖拖拉拉的过了一个月才写给他。
'*****************************************************************************
' FileName: Manage_Subst.VBS
' Author: baomaboy
' Abstract: 生成/卸载虚拟磁盘
'*****************************************************************************
Dim WshSHell,FSO
On Error Resume Next
Set WshSHell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WinVer = WshSHell.Environment("Process")
Set Args = WScript.Arguments
CloseTime = 5
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
FilePath = FSO.GetParentFolderName(FileFullName)
InsPath = FSO.GetSpecialFolder(1)'''0=windows,1=system32,2=user-Temp,
InsFullName = FSO.BuildPath(InsPath ,FileName)
Copyright="玲珑科技"
QQ="QQ:25926183"
Email="Email:25926183@qq.com"
InsTitle="生成/卸载虚拟磁盘"
InsAnswer="生成/卸载虚拟磁盘"
RegPath1="HKEY_CLASSES_ROOT\Directory\shell\Manage_Subst\"
RegValue1="生成虚拟系统磁盘"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\Directory\shell\Manage_Subst\command\"
RegValue2="wscript.exe """& InsFullName &""" ""%L"""
RegPath3="HKEY_CLASSES_ROOT\Drive\shell\Manage_Subst\"
RegValue3="卸载虚拟系统磁盘"
RegPath4="HKEY_CLASSES_ROOT\Drive\shell\Manage_Subst\command\"
RegValue13="open"
WshSHell.RegWrite "HKEY_CLASSES_ROOT\Drive\shell\",RegValue13,RegForm1
WshSHell.RegWrite "HKEY_CLASSES_ROOT\Folder\shell\",RegValue13,RegForm1
WshSHell.RegWrite "HKEY_CLASSES_ROOT\Directory\shell\",RegValue13,RegForm1
IF FileFullName <> InsFullName then
intAnswer = MsgBox("【是】将“生成/卸载虚拟磁盘”加入到右键菜单，"&Chr(10)&Chr(10)&"【否】将“生成/卸载虚拟磁盘”从右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - by baomaboy")
If intAnswer = vbYes Then
WshSHell.RegWrite RegPath1,RegValue1,RegForm1
WshSHell.RegWrite RegPath2,RegValue2,RegForm1
WshSHell.RegWrite RegPath3,RegValue3,RegForm1
WshSHell.RegWrite RegPath4,RegValue2,RegForm1
FSO.GetFile(FileFullName).Copy(InsFullName)
WshSHell.popup _
"添加脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"添加注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+chr(34)+ RegPath3 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "安装成功 - "+ InsTitle +" - by baomaboy", 0 + 64
end if
If intAnswer = vbNo Then
WshSHell.RegDelete RegPath4
WshSHell.RegDelete RegPath3
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(34)+ RegPath3 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "卸载成功 - "+ InsTitle +" - by baomaboy", 0 + 64
end if
If intAnswer = vbCancel Then
end if
Else
DiskList=UCase(ShowDriveList)
DiskNameStr="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
For i = 3 to 26
DiskTryStr=mid(DiskNameStr,i,1)
if InStr(DiskList,DiskTryStr)=0 then exit for
Next
if len(""""&Args(0)&"""") < 6 then
WshSHell.Run ("%COMSPEC% /C Subst "&Mid(Args(0),1,2)&" /D"),vbHide
else
WshSHell.Run ("%COMSPEC% /C Subst "&DiskTryStr&": """&Args(0)&""""),vbHide
end if
WScript.Sleep 500
WshSHell.SendKeys "{F5}+{F10}e"
End If
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)
Function ShowDriveList()
Set dc = fso.Drives
For Each d in dc
s = s & d.DriveLetter
Next
ShowDriveList = s
End Function
