Code Snippet
'
'Tiago Belo - 25102008 - tiagobelo@gmail.com
'
'Declarando as variáveis
Option Explicit
Dim strDriveLetter, strAlpha, intAlpha, intCount, strDNSDomain, strList
Dim objNetwork, objShell, objSysInfo, objUser, objGroup, strGroup, strGroupPath, strGroupName, bUpdateProfile, bForce
Dim CheckDrive, DriveExists, intDrive, strUserDN, arrGroups, arrGroup
Dim objRootLDAP, objmemberOf
'Obtendo informações sobre o domínio
Set objRootLDAP = GetObject("LDAP://RootDSE")
strDNSDomain = objRootLDAP.Get("DefaultNamingContext")
'Definindo valores para as variáveis
strDriveLetter = "H:"
strAlpha = "HIJLMNOPQRSUV"
intAlpha = 0
intCount = 0
err.number= vbEmpty
Set objShell = CreateObject("WScript.Shell")
Set objNetwork = CreateObject("WScript.Network")
Set CheckDrive = objNetwork.EnumNetworkDrives()
Set objSysInfo = CreateObject("ADSystemInfo")
strUserDN = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUserDN)
arrGroups = objUser.memberOf
bForce = "True"
bUpdateProfile = "True"
'Inicio - Removendo unidades
'Set objShell = CreateObject("WScript.Shell")
'Set objNetwork = CreateObject("WScript.Network")
'Set CheckDrive = objNetwork.EnumNetworkDrives()
On Error Resume Next
DriveExists = False
For intCount = 1 To 16
DriveExists = False
For intDrive = 0 To CheckDrive.Count - 1 Step 2
If CheckDrive.Item(intDrive) = strDriveLetter _
Then DriveExists = True
Next
intAlpha = intAlpha + 1
If DriveExists = True Then objNetwork.RemoveNetworkDrive strDriveLetter, bforce, bUpdateProfile
strDriveLetter = Mid(strAlpha, intAlpha,1) & ":"
If DriveExists = False Then DriveExists = True
Next
'Fim - Removendo unidades
'Inicio do bloco de programacao que realiza o mapeamento dos diretórios de acordo com os grupos ao qual o usuário é membro
strDriveLetter = "H:"
strAlpha = "HIJLMNOPQRSUV"
intAlpha = 0
intAlpha = intAlpha + 1
'Início - Verificacao dos grupos ao qual o usuário é membro
'No bloco IF abaixo é feito uma verificação e é apresentado uma mensagem caso o usuário não pertença a grupo algum
If IsEmpty(arrGroups) Then
Wscript.Echo "Este usuário não esta associado a um grupo de segurança. Por favor, procure o departamento de informática."
'No bloco ElseIF abaixo é feito uma verificação caso o retorno da verificação quantos aos grupos venha em formato string. Assim sendo, o tratamento será diferente para a verificação dos grupos.
ElseIf (TypeName(arrGroups) = "String") Then
objmemberOf = objUser.GetEx("memberOf")
For Each objGroup in objmemberOf
objGroup = Mid(objGroup, 4, 330)
arrGroup = Split(objGroup, "," )
strList = strList & arrGroup(0)
'Aqui é informado como na estrutura abaixo o grupo e a este eh associado a subrotina
Select Case strList
Case "G Funcionarios Informatica"
Call GFuncionariosInformatica()
'Fim - Aqui é informado como na estrutura abaixo o grupo e a este eh associado a subrotina
End Select
Next
'No bloco Else abaixo o procedimento adotado para a verificação quantos aos grupos é diferente pois baseia-se no formato do retorno, que deve ter sido como array.
Else
For Each strGroup in objUser.MemberOf
strGroupPath = "LDAP://" & strGroup
Set objGroup = GetObject(strGroupPath)
strGroupName = objGroup.CN
'Aqui é informado como na estrutura abaixo o grupo e a este eh associado a subrotina
Select Case strGroupName
Case "G Funcionarios Informatica"
Call GFuncionariosInformatica()
End Select
'FIM - Aqui é informado como na estrutura abaixo o grupo e a este eh associado a subrotina
Next
End If
'Fim - Verificacao dos grupos ao qual o usuário é membro
'Inicio - Criacao das sub rotinas para os grupos
Sub GFuncionariosInformatica()
strDriveLetter = Mid(strAlpha, intAlpha,1) & ":"
objNetwork.MapNetworkDrive strDriveLetter, "\\servidor1\compartilhamento", True
intAlpha = intAlpha + 1
strDriveLetter = Mid(strAlpha, intAlpha,1) & ":"
objNetwork.MapNetworkDrive strDriveLetter, "\\servidor2\compartilhamento", True
intAlpha = intAlpha + 1
strDriveLetter = Mid(strAlpha, intAlpha,1) & ":"
objNetwork.MapNetworkDrive strDriveLetter, "\\servidor3\compartilhamento", True
intAlpha = intAlpha + 1
End Sub
'Fim - Criacao das sub rotinas para os grupos
'Mapeamentos fixos de areas comuns
objNetwork.MapNetworkDrive "T:", "\\SERVIDOR5\Forms", True
objNetwork.MapNetworkDrive "X:", "\\SERVIDOR6\Documentos", True
WScript.Quit(1)
