Board logo

标题: [原创]生成/卸载虚拟磁盘→VBS版 [打印本页]

作者: baomaboy     时间: 2008-3-27 17:04    标题: [原创]生成/卸载虚拟磁盘→VBS版

应空间里一个好友写的,就是包装一下subst命令,解决他所说盘符不能递增的问题。整日瞎忙没时间 拖拖拉拉的过了一个月才写给他。

  Quote:
'*****************************************************************************
' 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

 
作者: tvzml     时间: 2008-3-29 00:21
非常好,这我喜欢
作者: aibo28     时间: 2008-3-30 15:06
试试看。正在学习中
作者: eech     时间: 2008-4-8 03:46
呵呵,终于给我找到了,我下,我顶
作者: tvzml     时间: 2008-4-9 20:09
符合我需要的类型
作者: chishingchan     时间: 2008-6-23 14:03
参考学习...