directory mapping.vbs

又一个虚拟驱动盘影射器源码

' Neil Ramsbottom (c)2001
' [e-mail]
' http://www.nramsbottom.co.uk/ 
' ==============================
' This code is based on code by:
'
' Ian O'Connor
' http://website.lineone.net/~oc/
' [e-mail]
'
'


'To set this script up, you need only change this line
MountVirtualDrive "C:\","M"




Sub MountVirtualDrive(strFolderPath, strDrive)

' Author:	Ian O'Connor
' Date:		
' Revisions:	Neil Ramsbottom
' RevDate:	10/01/2001
' Notes:	A few program flow changes, friendly names
'		& cleanup code added - NR
' 

'Suppress any non-script based errors
On Error Resume Next

	Dim objFileSystem
	Dim objWScriptShell

	'Make suitable for use with the subst command
	strDrive = strDrive &":"

	'Create objects
	Set objFileSystem = Wscript.CreateObject("Scripting.FileSystemObject")
	Set objWScriptShell = Wscript.CreateObject("WScript.Shell")

	'Does the drive exist?
	If objFileSystem.FolderExists(strDrive) Then
		'If so, attempt to unmount the drive
		UnMountVirtualDrive(strDrive)
		Exit Sub
	End If
	
	
	If Not objFileSystem.FolderExists(strFolderPath) Then
		objFileSystem.CreateFolder(strFolderPath)
	End If


	'Execute the command	
	objWScriptShell.Run("subst " & strDrive & " " & strFolderPath)

	'Unload objects - very important!	
	Set objWScriptShell = Nothing
	Set objFileSystem = Nothing
	
End Sub



Sub UnMountVirtualDrive(strDrive)

' Author:	Neil Ramsbottom
' Date:		10/01/2001
' Purpose:	Unmounts the mapped directory
' Notes:	The use of 'On Error Resume Next' is because I want this
'		script to be used on bootup/shutdown
'

On Error Resume Next

	Dim objWScriptShell
	
	Set objWScriptShell = Wscript.CreateObject("WScript.Shell")

	'Remember to pass strDrive as "x:"
	objWScriptShell.Run("subst " & strDrive & " /D")
	
	Set objWScriptShell = Nothing
	
End Sub