Inicio Soporte Técnico VBScript para obtener listado de unidades asignadas (Mapped Drives)

VBScript para obtener listado de unidades asignadas (Mapped Drives)

3033
0

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 & "rootcimv2")
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

Te recomendamos  Eliminar correo electrónico permanentemente en Outlook

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.

 

 

Artículos relacionadosMás del autor