1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
| Option Explicit
Dim objNetwork, objSysInfo, strUserDN
Dim objGroupList, objUser, objFSO
Dim strComputerDN, objComputer
Dim WshShell, SHell
Dim oFS, oWS
Dim strHomeDrive
Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSysInfo = CreateObject("ADSystemInfo")
strUserDN = objSysInfo.userName
strComputerDN = objSysInfo.computerName
Set WshShell = WScript.CreateObject("WScript.Shell")
Set Shell = CreateObject("Shell.Application")
Set oWS = WScript.CreateObject("WScript.Shell")
Set oFS = WScript.CreateObject("Scripting.FileSystemObject")
' Bind to the user and computer objects with the LDAP provider.
Set objUser = GetObject("LDAP://" & strUserDN)
Set objComputer = GetObject("LDAP://" & strComputerDN)
' Launch of deploy.bat for Odbc registry changes
' set wshSell = CreateObject("WScript.Shell")
' wshSHell.run "\\tmsvrdc1\NETLOGON\deploy.bat"
' set wshSHell = nothing
' == Mapped Drives Deconnection ==
Dim objShell, CheckDrive
Dim strDriveLetter, strRemotePath, intDrive, bforce
bforce = false
' This sections creates two objects:
' objShell and objNetwork and counts the drives
Set objShell = CreateObject("WScript.Shell")
Set objNetwork = CreateObject("WScript.Network")
Set CheckDrive = objNetwork.EnumNetworkDrives()
' This section deletes all mapped network drives
On Error Resume Next
For intDrive = 0 To CheckDrive.Count - 1 Step 2
objNetwork.RemoveNetworkDrive _
CheckDrive.Item(intDrive), bforce
Next
' Mapping network drives if the user is a member of the group.
' == maps pour les utilisateurs ******* ==
'If IsMember(objUser, "********") Then
'objNetwork.MapNetworkDrive "X:", "chemin du partage" ,False
'end if
' == Maps pour les Domains Users ==
objNetwork.MapNetworkDrive "H:", "Chemin du partage" & objNetwork.UserName ,False
objNetwork.MapNetworkDrive "T:", "Chemin du partage" ,False
objNetwork.MapNetworkDrive "U:", "Chemin du partage" ,False
' Clean up.
Set objNetwork = Nothing
Set objFSO = Nothing
Set objSysInfo = Nothing
Set objGroupList = Nothing
Set objUser = Nothing
Set objComputer = Nothing
Set oWS = Nothing
Set oFS = Nothing
Function IsMember(objADObject, strGroup)
' Function to test for group membership.
' objGroupList is a dictionary object with global scope.
If IsEmpty(objGroupList) Then
Set objGroupList = CreateObject("Scripting.Dictionary")
End If
If Not objGroupList.Exists(objADObject.sAMAccountName & "\") Then
Call LoadGroups(objADObject, objADObject)
objGroupList(objADObject.sAMAccountName & "\") = True
End If
IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" _
& strGroup)
End Function
Function IsFile(fName)
On Error Resume Next
If oFS.FileExists(fName) Then IsFile = True Else IsFile = False
On Error Goto 0
End Function
Sub LoadGroups(objPriObject, objADSubObject)
' Recursive subroutine to populate dictionary object objGroupList.
Dim colstrGroups, objGroup, j
objGroupList.CompareMode = vbTextCompare
colstrGroups = objADSubObject.memberOf
If IsEmpty(colstrGroups) Then
Exit Sub
End If
If TypeName(colstrGroups) = "String" Then
Set objGroup = GetObject("LDAP://" & colstrGroups)
If Not objGroupList.Exists(objPriObject.sAMAccountName & "\" _
& objGroup.sAMAccountName) Then
objGroupList(objPriObject.sAMAccountName & "\" _
& objGroup.sAMAccountName) = True
Call LoadGroups(objPriObject, objGroup)
End If
Set objGroup = Nothing
Exit Sub
End If
For j = 0 To UBound(colstrGroups)
Set objGroup = GetObject("LDAP://" & colstrGroups(j))
If Not objGroupList.Exists(objPriObject.sAMAccountName & "\" _
& objGroup.sAMAccountName) Then
objGroupList(objPriObject.sAMAccountName & "\" _
& objGroup.sAMAccountName) = True
Call LoadGroups(objPriObject, objGroup)
End If
Next
Set objGroup = Nothing
End Sub
WScript.Quit |
Partager