[问题求助] 怎样用VBS实现自动识别系统分区，自动分配盘符？

5i365

情况是这样的，我的电脑刚安装好双系统（WIN7+WIN10）的时候，进入每个系统后，另一系统的分区都是可见的，怕误操作，所以想隐藏它，这我一般的处理是，打开磁盘管理，然后找到另一个系统所在的分区，右键，选择《更改驱动器号和路径》-----《删除》，这个操作就把另一系统的驱动器号删除了，也算是变相隐藏了分区，但是后面分区的盘符，就都要手动修改一下，两个系统下都要按上面的过程来一遍！

具体描述：WIN7是C盘，WIN10是D盘，软件盘是E盘，备份盘是F盘，把D盘驱动器号删除后，E盘要改为D盘，F盘要改为E盘。

我想请教各位高手，能不能把上面的操作实现：自动识别另一WIN系统分区，自动分配盘符，有没有可能性？

因为对VBS不熟悉，只懂点基本的批处理，想了一下大概的思路，

1.先识别当前硬盘是否存在两个系统分区，有则获取另一系统的驱动器号

2.使用VBS某个函数，删除驱动器号

3.使用VBS某个函数，循环分配后面的驱动器号

如果有大师有别的思路，也希望能不衰赐教，提前感谢！

flashercs

Option Explicit
' On Error Resume Next
Dim strDriveLetter,objWbemService,colVolumes,objVolume
strDriveLetter = "D"
Set objWbemService = GetObject("winmgmts:{ImpersonationLevel=Impersonate}!//./root/cimv2")
Set colVolumes = objWbemService.ExecQuery("Select DeviceID,DriveLetter,Label,Name,SerialNumber From Win32_Volume Where BootVolume=False And SystemVolume=False And DriveType=3")
For Each objVolume In colVolumes
'系统盘卷标是Win7 或 Win10
  If LCase(Left(objVolume.Label,3)) = "win" Then
    objVolume.Dismount True,True
    ' ShowError
  Else
    If UCase(Left(objVolume.DriveLetter,1)) <> strDriveLetter Then
      objVolume.DriveLetter = strDriveLetter & ":"
    End If
    If strDriveLetter = "Z" Then Exit For
    strDriveLetter = Chr(Asc(strDriveLetter) + 1)
  End If
Next
Set objVolume = Nothing
Set colVolumes = Nothing
Set objWbemService = Nothing
复制代码

5i365

回复 2# flashercs

感谢楼上朋友的帮忙，我双击VBS文件后没有任何反应，不知道怎么回事，我现在系统中的卷标，分别是win7  C:    win10  D:   DATA  G:

flashercs

以管理员身份打开cmd.exe，输入cscript -nologo A.vbs
回车

flashercs

A.vbs

Option Explicit
' On Error Resume Next
Dim strDriveLetter,objWbemService,colVolumes,objVolume
strDriveLetter = "D"
Set objWbemService = GetObject("winmgmts:{ImpersonationLevel=Impersonate}!//./root/cimv2")
Set colVolumes = objWbemService.ExecQuery("Select DeviceID,DriveLetter,Label,Name,SerialNumber From Win32_Volume Where BootVolume=False And SystemVolume=False And DriveType=3")
For Each objVolume In colVolumes
  If LCase(Left(objVolume.Label,3)) = "win" Then
    WSH.Echo "Dismounting volume: " & objVolume.DriveLetter & " with Label: " & objVolume.Label
    objVolume.Dismount True,True
    ' ShowError
  Else
    If UCase(Left(objVolume.DriveLetter,1)) <> strDriveLetter Then
      WSH.Echo "Assign new driveLetter: " & strDriveLetter & " to " & strDriveLetter
      objVolume.DriveLetter = strDriveLetter & ":"
    End If
    If strDriveLetter = "Z" Then Exit For
    strDriveLetter = Chr(Asc(strDriveLetter) + 1)
  End If
  ' WSH.Echo objVolume.DriveLetter & vbTab & objVolume.DeviceID
Next
Set objVolume = Nothing
Set colVolumes = Nothing
Set objWbemService = Nothing
复制代码

5i365

回复 5# flashercs
还是不行，目前就是AD帐户

    这是操作演示
https://ibb.co/4Zv8Wj0

flashercs

你权限不够啊

flashercs

Option Explicit
' On Error Resume Next
Dim strDriveLetter,objWbemService,colVolumes,objVolume,retValue
strDriveLetter = "D"
Set objWbemService = GetObject("winmgmts:{ImpersonationLevel=Impersonate}!//./root/cimv2")
Set colVolumes = objWbemService.ExecQuery("Select DeviceID,DriveLetter,Label,Name,SerialNumber From Win32_Volume Where BootVolume=False And SystemVolume=False And DriveType=3")
For Each objVolume In colVolumes
  If LCase(Left(objVolume.Label,3)) = "win" Then
    WSH.Echo "Dismounting volume: " & objVolume.DriveLetter & " with Label: " & objVolume.Label
    retValue = objVolume.Dismount(True,True)
    If retValue = 0 Then
      WSH.Echo "Success"
    Else
      WSH.Echo "Failed : " & retValue
    End If
    ' ShowError
  Else
    If UCase(Left(objVolume.DriveLetter,1)) <> strDriveLetter Then
      WSH.Echo "Assign new driveLetter: " & objVolume.DriveLetter & ": to " & strDriveLetter & ":"
      
      objVolume.DriveLetter = strDriveLetter & ":"
      
      End If
    If strDriveLetter = "Z" Then Exit For
    strDriveLetter = Chr(Asc(strDriveLetter) + 1)
  End If
  ' WSH.Echo objVolume.DriveLetter & vbTab & objVolume.DeviceID
Next
Set objVolume = Nothing
Set colVolumes = Nothing
Set objWbemService = Nothing
复制代码

5i365

回复 8# flashercs

非常感谢这么晚还给俺回复，现在系统是新安装的，开启的AD帐号，现在还是无法执行

下面是图片演示
https://www.z4a.net/image/7RbHFG

flashercs

回复 9# 5i365

关于如何获得管理员至高无上权限的方法，自行百度。下面这个可以检测是否获取最高权限。

Option Explicit
On Error Resume Next
Dim strDriveLetter,objWbemService,colVolumes,objVolume,retValue
Set objWbemService = GetObject("winmgmts:{ImpersonationLevel=Impersonate}!//./root/cimv2")
objWbemService.Get "Win32_LogonSession.LogonId='999'"
If Err.Number <> 0 Then
  ' ShowError
  WSH.Echo "Lower Privilege.权限太低了。"
  Set objWbemService = Nothing
  WSH.Quit 1
End If
strDriveLetter = "D"
Set colVolumes = objWbemService.ExecQuery("Select DeviceID,DriveLetter,Label,Name,SerialNumber From Win32_Volume Where BootVolume=False And SystemVolume=False And DriveType=3")
For Each objVolume In colVolumes
  If LCase(Left(objVolume.Label,3)) = "win" Then
    WSH.Echo "Dismounting volume: " & objVolume.DriveLetter & " with Label: " & objVolume.Label
    retValue = objVolume.Dismount(True,True)
    If retValue = 0 Then
      WSH.Echo "Success"
    Else
      WSH.Echo "Failed : " & retValue
    End If
    ' ShowError
  Else
    If UCase(Left(objVolume.DriveLetter,1)) <> strDriveLetter Then
      WSH.Echo "Assign new driveLetter: " & objVolume.DriveLetter & ": to " & strDriveLetter & ":"
      ' retValue = objVolume.Dismount(True,False)
      objVolume.DriveLetter = strDriveLetter & ":"
      ' retValue = objVolume.Mount()
    End If
    If strDriveLetter = "Z" Then Exit For
    strDriveLetter = Chr(Asc(strDriveLetter) + 1)
  End If
  ' WSH.Echo objVolume.DriveLetter & vbTab & objVolume.DeviceID
Next
Set objVolume = Nothing
Set colVolumes = Nothing
Set objWbemService = Nothing
复制代码

5i365

回复 10# flashercs

上面的代码运行后，没有提示权限，下面是演示

https://ibb.co/8jbcc7N

5i365

我在一款磁盘工具BOOTICE中的帮助中，看到它支持命令行，里面有如下的说明，但是我不懂怎么用VBS执行命令行，能帮助用这个第三方工具的命令行实现一下吗？感谢：

我试了一下，用bootice.exe /device=D: /partitions /delete_letter  可以删除D盘的盘符，但是分配盘符不成功！

【分区及格式化】
────────────────────────────────
BOOTICE [DEVICE] /partitions [operation]
────────────────────────────────
operation:
/hide            >> 隐藏 /device= 指定的分区
/assign_letter   >> 为指定分区分配盘符（自动分配第一个可用盘符）
/assign_letter=X >> 为指定分区分配盘符（盘符由用户指定）
/delete_letter   >> 删除指定分区的盘符

5i365

回复 10# flashercs

在百度搜到下面的一个贴子，大师能给加到VBS中吗？我已经下载了PSexec，感谢

http://bbs.pcbeta.com/viewthread-1773720-1-1.html

xczxczxcz

Admistrator 对有些文件也无权读写。因某些文件的ACCESSCONTROL 需要添加owner提权才可操作。

xp3000

这个以后需要用到