NetMap.vbs
 Запускается при входе пользователя. ActiveDirectory  обязателен.
 Если юзер входит в группу, то ему подключается сетевой диск
 иначе сетевой диск с таким именем отключается(если есть).
 Имена дисков сменяться только после второго входа.


Файл NetMap.vbs
   

'###################################### [BEGIN] ######################################
' Орлов В.И.
' Дата последнего изменения: 25.10.2010
' ICQ: 5279603
'
'  
Option Explicit  
On Error Resume Next  
  
if hour(now) > 21 then
   Wscript.Quit(0) ' ибо не хрен работать после 22 часов - мешает работать обслуживающим службам сети.
end if


   Dim WshShell, objRegistry, RegPath, WshNetwork, objFSO, Msg
   Dim strUserDN, objSysInfo, GroupObj, UserGroups, UserObj 

   Set WshShell            = WScript.CreateObject("WScript.Shell")  
   Set objSysInfo          = CreateObject("ADSystemInfo")   
   strUserDN               = objSysInfo.userName   
   Set UserObj             = GetObject("LDAP://" & strUserDN)   
   Set objRegistry         = GetObject("winmgmts:\\.\root\default:StdRegProv")
   Set WshNetwork          = WScript.CreateObject("WScript.Network")  
   Set objFSO              = CreateObject("Scripting.FileSystemObject") 
   Const HKCU              = &H80000001
   Const V7_REGISTRY_PATH  = "Software\Microsoft\Windows\CurrentVersion\Explorer\MountPoints2"
   UserGroups              = ""    
 
   For Each GroupObj In UserObj.Groups    
      UserGroups=UserGroups & "[" & GroupObj.Name & "]"    
   Next    
 
if InGroup("dfsprivat") then    
        MapDrv "I:", "\\domen.lan\dfs\private\"  & WshShell.ExpandEnvironmentStrings("%USERNAME%"), "Мой диск" ' У каждого юзера свой личный сетевой диск
else
        MapDrv "I:", "dell", ""
end if   

if InGroup("DFS_IT") then    
        MapDrv "Q:", "\\domen.lan\dfs\ITotdel", "IT_отдел"
else
        MapDrv "Q:", "dell", "\\domen.lan\dfs\ITotdel"  
end if   
if InGroup("DFSwork") then    
        MapDrv "R:", "\\domen.lan\dfs\works", "Работа"
else
        MapDrv "R:", "dell", "\\domen.lan\dfs\works" 
end if   
if InGroup("DFSTemp") then    
        MapDrv "T:", "\\domen.lan\dfs\Temp", "TempDisk"
else
        MapDrv "T:", "dell", "\\domen.lan\dfs\Temp"
end if   
if InGroup("DFSpublic") then    
        MapDrv "J:", "\\domen.lan\dfs\public", "Public"  ' Как правило бардак и хлам ))
else
        MapDrv "J:", "dell", "\\domen.lan\dfs\public" 
end if   


   Set objRegistry   = Nothing
   Set WshShell      = Nothing
   Set objSysInfo    = Nothing
   Set UserObj       = Nothing
   Set WshNetwork    = Nothing
   Set objFSO        = Nothing
   Wscript.Quit(0)

   
'==========================================================================  
' ДАЛЕЕ ФУНКЦИИ
' 
' Function MapDrv(DrvLet, UNCPath, DiskName)  
'  
' DrvLet -  Буква устройства  
' UNCPath - Сетевой путь  
' DiskName - Строковое название диска или сетевой путь шары при удалении
' COMMENT: Подключение сетевых дисков с записью ошибок в EventLog  
'  
'==========================================================================  
Function MapDrv(DrvLet, UNCPath, DiskName)  
   if UNCPath <> "dell" then ' Если не сказано удалить, ПОДКЛЮЧАЕМ
      ' если существует такой диск 
      if objFSO.DriveExists(DrvLet) then
         ' НО с другим путем
         if UNCPath <> CreateObject("Scripting.FileSystemObject").GetDrive(CreateObject("Scripting.FileSystemObject").GetDriveName(DrvLet)).ShareName then
            ' отключаем диск
            WshNetwork.RemoveNetworkDrive DrvLet, true, true 
            ' малость ждем`c
            wscript.sleep 500 
            ' подключаем диск
            WshNetwork.MapNetworkDrive DrvLet, UNCPath
            ' Делее переименовываем сетевой диск
               if DiskName = "" then
                  DiskName = Right(UNCPath, len(UNCPath)-InStrRev(UNCPath, "\"))
               end if
               RegPath = "\" & replace(UNCPath,"\","#") & "\"
               objRegistry.SetStringValue HKCU, V7_REGISTRY_PATH & RegPath, "_LabelFromReg", DiskName 
         end if
      else ' Если диска такого нет
            ' подключаем диск
            WshNetwork.MapNetworkDrive DrvLet, UNCPath
            ' Делее переименовываем сетевой диск
               if DiskName = "" then
                  DiskName = Right(UNCPath, len(UNCPath)-InStrRev(UNCPath, "\"))
               end if
               RegPath = "\" & replace(UNCPath,"\","#") & "\"
               objRegistry.SetStringValue HKCU, V7_REGISTRY_PATH & RegPath, "_LabelFromReg", DiskName 
      end if
   else ' Если сказано УДАЛИТЬ диск
       If objFSO.DriveExists(DrvLet) Then  ' Проверяем есть ли диск с таким именем
          ' Проверяем такой ли путь у диска (а то отключим не тот)
          ' подумал и решил. если путь диска другой то ТЕМ БОЛЕЕ ОТКЛЮЧАЕМ (а то будет доступ к диску которого не надо)
         'if DiskName = CreateObject("Scripting.FileSystemObject").GetDrive(CreateObject("Scripting.FileSystemObject").GetDriveName(DrvLet)).ShareName then
            ' ОТКЛЮЧАЕМ
            WshNetwork.RemoveNetworkDrive DrvLet, true, true 
         'end if
       End If 
   end if
   Select Case Err.Number  
        Case 0            ' No error  
  
         Case -2147024843 ' не найден сетевой путь

        Case Else  
  
            Msg = "Mapping network drive error: " & _   
                   CStr(Err.Number) & " 0x" & Hex(Err.Number) & vbCrLf & _  
                  "Error description: " & Err.Description & vbCrLf  
            Msg = Msg & "Domain: " & WshNetwork.UserDomain & vbCrLf  
            Msg = Msg & "Computer Name: " & WshNetwork.ComputerName & vbCrLf  
            Msg = Msg & "User Name: " & WshNetwork.UserName & " - " & UserObj.CN & vbCrLf & vbCrLf  
            Msg = Msg & "Device name: " & DrvLet & vbCrLf  
            Msg = Msg & "Map path: " & UNCPath   
  
'            WshShell.LogEvent 1, Msg, "\\pc101" ' Этой строкой я засирал свой евент о подключениях сетевых дисков :)
    End Select  
End Function 
 
 
'==========================================================================  
' Function InGroup(strGroup) 
' strGroup - группа, принадлежность к которой проверяем 
' COMMENT: проверка принадлежности пользователя к группе 
'==========================================================================  
Function InGroup(strGroup)    
        InGroup=False    
        If InStr(UserGroups,"[CN=" & strGroup & "]") Then    
                InGroup=True    
        End If    
End Function 

'==========================================================================  
' Function TestDisk(Dname, Dpath) возвращает true если есть такой диск.
' Dname - Имя подключенного сетевого диска например N: или P:  
' Dpath - Путь к подключаемому общему ресурсу этого диска.  например \\server\share
'==========================================================================  
function TestDisk(Dname, Dpath)
   Dim objDrv
   TestDisk = false
   Set objDrv = CreateObject("Scripting.FileSystemObject").Drives
   For Each Drive In objDrv
      if Drive.IsReady then
         if lcase(Drive.Path) = lcase(Dname) and lcase(Drive.ShareName) = lcase(Dpath) then
            TestDisk = true
            Exit for
         end if
      end if
   next
   Set objDrv = Nothing
end function

'###################################### [END] ######################################