Affichage des icônes lecteurs réseau sur le bureau

'-------------------------------------------------------------------------------------------------------------------------- '(c) 2006-2011 KoXo Dev. Script VBS Eleves '-------------------------------------------------------------------------------------------------------------------------- 'Unmap existing drives UnconnDrives Set UserObj=FindUser If Not IsEmpty(UserObj) Then 'Map Home Drive ConnectDrive UserObj.HomeDirDrive,UserObj.HomeDirectory,"Espace personnel de "+UserObj.fullName 'Folders redirection (remove next line if managed with GPO) Redirections UserObj.HomeDirDrive End If 'Map Group Drive ConnectDrive "Q:","\\%SECONDARY_GROUP_SERVER%\%SECONDARY_GROUP%$","Ma classe [%SECONDARY_GROUP%]" Shortcut GetDesktop & "\Espace personnel.lnk","Espace personnel","CTRL+ALT+SHIFT+H","P:" Shortcut GetDesktop & "\Espace de groupe.lnk","Espace de groupe","CTRL+ALT+SHIFT+G","Q:" 'Remove next quote to manage printers with a simple text file in netlogon 'Execute GetLogonServer+"\NETLOGON\Printers.vbs" 'Remove next quote to display user and computer informations on the wallpaper Execute GetLogonServer+"\NETLOGON\Wallpaper.vbs /wallpaper=\\%SERVER[1]%\NETLOGON\Wallpaper.bmp" 'End WScript.Quit '-------------------------------------------------------------------------------------------------------------------------- '/////////// '// Execute function execute(CommandLine) On Error Resume Next Dim oShell Set oShell=CreateObject("WScript.Shell") err.Number=0 oShell.Run CommandLine,1,True If err.number<>0 Then oShell.Popup "Execution : " & CommandLine & VbCrLf & "Description=" & err.Description & VbCrLf & "Code=" & err.Number,5,"Erreur",64 End If end function '//////////////// '// Redirections function Redirections(Drive) On Error Resume Next Dim oShell Dim Reg,Personnal,Favorites,Templates,History,AppData,Cookies,ExcludeProfileDirs Set oShell=CreateObject("WScript.Shell") Personnal="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Personal" Reg=oShell.RegWrite(Personnal,Drive+"\Mes documents","REG_SZ") Favorites="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Favorites" Reg=oShell.RegWrite(Favorites,Drive+"\CONFIG\Favoris","REG_SZ") Templates="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Templates" Reg=oShell.RegWrite(Templates,Drive+"\CONFIG\Modeles","REG_SZ") History="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\History" Reg=oShell.RegWrite(History,Drive+"\CONFIG\Historique","REG_SZ") 'AppData="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData" 'Reg=oShell.RegWrite(AppData,Drive+"\CONFIG\Application Data","REG_SZ") 'Cookies="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Cookies" 'Reg=oShell.RegWrite(Cookies,Drive+"\CONFIG\Cookies","REG_SZ") ExcludeProfileDirs="HKEY_CURRENT_USER\Software\Policies\Microsoft\Windows\System\ExcludeProfileDirs" Reg=oShell.RegWrite(ExcludeProfileDirs,"Mes Documents;Favoris;Bureau;Menu démarrer;Application Data;Cookies;Modèles","REG_SZ") End function '//////////////////////////////// '// Unconnect all network drives function UnconnDrives() On Error Resume Next Dim objNetwork Dim i,colDrives Set objNetwork=WScript.CreateObject("WScript.Network") 'Unmap existing drives Set colDrives=objNetwork.EnumNetworkDrives If colDrives.Count<>0 Then For i=0 To colDrives.Count-1 Step 2 objNetwork.RemoveNetworkDrive colDrives(i),"True","True" Next End If End function '///////////////////// '// Find a user in AD function FindUser() On Error Resume Next Dim objNetwork,oScriptShell Dim strUserName,strUserDomain,sUserObj Dim i,UserObj Set objNetwork=WScript.CreateObject("WScript.Network") Set oScriptShell=CreateObject("WScript.Shell") strUserName=objNetwork.UserName strUserDomain=objNetwork.UserDomain sUserObj="WinNT://" & strUserDomain & "/" & strUserName i=0 Do i=i+1 Set UserObj=GetObject(sUserObj) If UserObj Is Nothing Then WScript.Sleep 1000 End If Loop While (i<20) And IsEmpty(UserObj) If UserObj Is Nothing Then oScriptShell.Popup "Impossible de trouver : " & sUserObj,5,"Erreur GetObject",64 End If Set FindUser=UserObj End function '/////////////////// '// Connect a drive function ConnectDrive(Drive,Path,Description) On Error Resume Next Dim objNetwork,oScriptShell Set objNetwork=WScript.CreateObject("WScript.Network") Set oScriptShell=CreateObject("WScript.Shell") Set oShell=CreateObject("Shell.Application") err.number=0 objNetwork.MapNetworkDrive Drive,Path If err.number<>0 Then oScriptShell.Popup "Connexion lecteur " & Drive & " (" & Path & ")" & VbCrLf & "Description=" & err.Description & VbCrLf & "Code=" & err.Number,5,"Erreur",64 Else oShell.NameSpace(Drive).Self.Name=Description End If end function '////////////////////// '// Get the LogonServer function GetLogonServer() Dim objShell Set objShell=Wscript.CreateObject("Wscript.Shell") GetLogonServer=objShell.ExpandEnvironmentStrings("%LOGONSERVER%") End Function '//////////////////////////////////////////////////////////////// '// Get "Desktop" Function GetDesktop() Dim objShell Set objShell=CreateObject("WScript.Shell") GetDesktop=objShell.SpecialFolders("Desktop") End Function '//////////////////////////////////////////////////////////////// '// Make shortcut Function Shortcut(FilePath,Description,HotKey,TargetPath) Dim objLink, objShell Set objShell=CreateObject("WScript.Shell") Set objLink=objShell.CreateShortcut(FilePath) objLink.Description=Description objLink.HotKey=Hotkey objLink.TargetPath=TargetPath objLink.WindowStyle=3 objLink.Save End Function '////////////////////////////////////////////////////////////////