[Script] Ocultando unidades do Windows com VBScript

Scripts diversos para automatizar tarefas em servidores ou auxilio com tarefas administrativas.
Avatar do usuário
marceloleaes
Administrator
Administrator
Mensagens: 1516
Registrado em: 10 Jun 2013 12:45
Localização: Novo Hamburgo
Idade: 41
Contato:
Status: Offline

[Script] Ocultando unidades do Windows com VBScript

Mensagem por marceloleaes »

Script com a função de esconder unidades do sistema operacional, muito util para que os usuários não acessem unidades de system restore ou mesmo OEM disponibilizados pelos fabricantes de desktop ou notebooks. Execute e informe quais unidades deseja ocultar.

Script

Código: Selecionar todos

' =================================================================================================
' Script para ocultar partições do sistema operacional
' Por Marcelo Leães - [email protected]
' =================================================================================================

Option Explicit

Sub Main()
	On Error Resume Next  
	Dim objShell, PATH, bits,Drive,substr
	Dim fso, d, drives,s,count 
	Dim exitcode 
	Dim x, i , j
	exitcode = 0
	bits = 0
	Set objShell = CreateObject("WScript.Shell")
	PATH = "HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDrives"
	Drive = inputbox("Informe as unidades que deseja ocultar separadas por virgula, exemplo: D,E,F ou somente D E ou F")
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set drives= fso.Drives
	If UCase(Drive) = "SHOWALL" Then 
		objShell.RegDelete PATH
		If Err = 0 Then 
			Call RefreshExplorer
			Err.clear
		Else 
			wscript.echo  "Precisa de permissoes de Administrador para aplicar as alteracoes."
			Err.clear
		End If 
	Else 
		For i = 1 To Len(Drive)
			substr= Mid(Drive,i,1)
			x = 0
			For j = Asc("A") To Asc("Z")
				If Chr(j) = UCase(substr) Then

					If InStr(Drive,substr) = InStrRev(Drive,substr)  Then 

					        If  fso.DriveExists(substr) Then 						
								bits = bits + 2^x 
							Else 
								wscript.echo "A unidade '"&UCase(substr)&"' parece nao existir!"
								exitcode = 1
								Exit For 
							End If 
					Else 
						wscript.echo "Algo duplicado, tente novamente"
						exitcode = 1
					End If 
				End If
				x = x + 1
			Next
			If exitcode = 1 Then
				Exit For 
			End If 
		Next

		Dim sNoDrives

		sNoDrives = objShell.RegRead(PATH)
		Err.clear
		If exitcode = 0 And drive <> "" Then 
			If bits = 0 Then 
				wscript.echo "Por favor insira algo como 'D,E' "
				Call Main
			Else 
				If sNoDrives = bits Then 
					wscript.echo "Procedimento realizado com Sucesso."
				Else 
					objShell.RegWrite PATH, bits, "REG_DWORD"
					If Err = 0 Then 
						Call RefreshExplorer
					Else 	
						wscript.echo
						wscript.echo  "Falha no procedimento. Faltou permissoes."
						Err.clear 
					End If 
				End If 
			End If 
		ElseIf exitcode = 1 Then 
			Call Main
		End If 
    End If 

End Sub 

Function RefreshExplorer()

	dim strComputer, objWMIService, colProcess, objProcess 
	strComputer = "."

	Set objWMIService = GetObject("winmgmts:" _
	  & "{impersonationLevel=impersonate}!\\" _ 
	  & strComputer & "\root\cimv2") 
	Set colProcess = objWMIService.ExecQuery _
	  ("Select * from Win32_Process Where Name = 'explorer.exe'")
	For Each objProcess in colProcess
	   objProcess.Terminate()
	Next 

End Function 

Call Main
Antes de executar:

Imagem

Após executar:

Imagem

Bom proveito  ;)
Você não está autorizado a ver ou baixar esse anexo.


"Transportai um punhado de terra todos os dias e fareis uma montanha." Confúcio

Voltar para “Scripts”