VBScript para obtener listado de unidades asignadas (Mapped Drives)

Cuando una tarea es repetitiva en ocasiones es necesario buscar alternativas de como generar mas fácilmente esta tarea, los Scripts Visual Basic nos pueden ayudar a realizar muchas tareas rápidamente proporcionando lo que deseamos con menos esfuerzo y mayor rapidez, esta vez requerimos un script que nos muestre las unidades asignadas y la ruta a la que apunta cada una, el cual nuestro compañero C Thompson a creado un excelente script el cual realiza esta tarea.

 

¿Como utilizar el script?

  • Abrimos Bloc de Notas (Notepad)
  • Copiamos el código del script.
  • Pegamos en Notepad
  • Guardamos el archivo con extensión .vbs
  • Ejecutamos el archivo dando doble clic sobre este (Si lo abre en notepad, es porque no se guardo con la extensión .vbs correctamente, [Ver articulo: Mostrar / Ocultar extensiones de archivos en Windows] y asegurarnos que termine en .vbs no en .txt).
  • Pedira el nombre del equipo (podemos poner el nombre o la direccion IP).2014-09-29_182219
  • Cuando termine nos preguntara si deseamos ver el detalle ponemos que Si.2014-09-29_182230
  • Nos desplegara un TXT con las unidades y la ruta a la que apuntan.2014-09-29_182239
  • El cual también guarda una log en una carpeta llamada “SysInfoCheck” en nuestro C:

Descargar Archivo

Puedes descargar el Script desde el siguiente enlace, este se modifico para que funcione correctamente en S.O. de 64 bit y se cambiaron los dialogo a español.

[wpfilebase tag=file id=43 /]

Código VBScript (Current User Mapped Drives)

El código original fue modificado para que este funcione en Windows 7 y 8 de 64 bit.

' Current User Mapped Drives V1.0

on error resume next

' ********** Get computer name from the user
strComputer=inputbox("Nombre de Equipo: ", "Current User Mapped Drives")

' ********** Define constants
Const HKEY_USERS = &H80000003

' ********** Blank the report message
strMsg = ""

' ********** Set objects 
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objWbem = GetObject("winmgmts:")
Set objRegistry = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")

if err.number = "-2147217375" then
	' Do nothing
else

	' ********** Check to make sure the computer exists on the network.
	Select Case err.number
		Case 462
			strWarn=MsgBox("Unable to connect to " & strComputer & ".", 48, "System Information Checker")
		Case -2147217394
			strWarn=MsgBox(strComputer & " is not a valid name.", 48, "System Information Checker")
		Case 70
			strWarn=MsgBox(strComputer & " has denied access.", 48, "System Information Checker")
    	Case Else

	' ********** Get the current user from Explorer   ' ********** and SessionID=0")

	Set colProc = objWmiService.ExecQuery("Select Name from Win32_Process" & " Where Name='explorer.exe'") 

	If colProc.Count > 0 Then
		For Each oProcess In colProc
			oProcess.GetOwner sUser, sDomain
		Next
	End If

	' ********** Print user and computer
	strMsg = strMsg & "    User: " & sUser & VbCrLf
	strMsg = strMsg & "Computer: " & strComputer & VbCrLf & VbCrLf
	

	' ********** Loop through the HKEY_USERS hive until the currently logged on user is matched
	lngRtn = objRegistry.EnumKey(HKEY_USERS, "", arrRegKeys)
	
	For Each strKey In arrRegKeys
		If UCase(strKey) = ".DEFAULT" Or UCase(Right(strKey, 8)) = "_CLASSES" Then
		Else
			Set objSID = objWbem.Get("Win32_SID.SID='" & strKey & "'")
			If objSID.accountname = sUser Then 
				regpath2enumerate = strkey & "\Network" 'strkey is the SID
				objRegistry.enumkey hkey_users, regpath2enumerate, arrkeynames
				
				If Not (IsEmpty(arrkeynames)) Then
					For Each subkey In arrkeynames
						regpath = strkey & "\Network\" & subkey
						regentry = "RemotePath"
						objRegistry.getstringvalue hkey_users, regpath, regentry, dapath
						strMsg = strMsg & subkey & ":" & vbTab & dapath & VbCrLf
					Next
				End If
			End If
		End If
	Next


		' ********** Check for the existence of the "SysInfoCheck" folder then
		' ********** write the file to disk.
		strDirectory = "C:\SysInfoCheck"
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		If objFSO.FolderExists(strDirectory) Then
    			' Procede
		Else
    			Set objFolder = objFSO.CreateFolder(strDirectory)
		End if

		' ********** Calculate date serial for filename **********
		intMonth = month(now)
		if intMonth < 10 then
			strThisMonth = "0" & intMonth
		else
			strThisMonth = intMOnth
		end if
		intDay = Day(now)
		if intDay < 10 then
			strThisDay = "0" & intDay
		else
			strThisDay = intDay
		end if
		strFilenameDateSerial = year(now) & strThisMonth & strThisDay

		Set objFile = objFSO.CreateTextFile(strDirectory & "\" & strComputer & "_" & sUser & "_MappedDrives" & "_" & strFilenameDateSerial & ".txt",True)	
		objFile.Write strMsg & vbCrLf

		' ********** Ask to view file
		strFinish = "Finished collecting mapped drives for computer: " & strComputer & "." & VbCrLf & VbCrLf & "View file?"
		strAnswer=MsgBox(strFinish, 68, "System Information Checker")
		if strAnswer = 6 then
    			Set objShell = CreateObject("WScript.Shell")
    			objShell.run strDirectory & "\" & strComputer & "_" & sUser & "_MappedDrives" & "_" & strFilenameDateSerial & ".txt"
		end if

	end select

end if

 Credito a C Thompson

También podemos ver las unidades Manualmente en el registro ver articulo: Como encontrar las unidades asignadas (Mapped Drives) en el registro de una computadora remota.

 

 

Califica este articulo

Fernando O.

Soy analista de sistemas actualmente trabajo en una empresa con mas de 200 empleados que utilizan equipo de computo al cual se les da soporte en el departamento.
Uno de mis pasatiempos fuera de la empresa es escribir artículos para PortalMasTips donde documento los problemas, inquietudes y detalles interesantes que se presentan.

2 comentarios en “VBScript para obtener listado de unidades asignadas (Mapped Drives)

Deja un comentario...

Compartir
Twittear
+1
Compartir
Pin
Stumble