forum.lissyara.su

Код: Выделить всё

'==========================================================================  
'  
' VBScript Source File  
'  
' NAME: MapDrivesInGroup.vbs 
'  
' COMMENT: Подключение сетевых дисков на основе групп с записью ошибок в EventLog  
'  
'==========================================================================  
  
Option Explicit  
'On Error Resume Next  
  
Dim WshShell, WshNetwork  
Dim strUserDN, objSysInfo, GroupObj, UserGroups, UserObj 
 
' Задаем имя файлового сервера, при использовании нескольких серверов  
' создаем несколько констант и используем их при вызове MapDrv 
Const FileSrv1 = "\\SRV1" 
 
UserGroups=""    
  
Set WshShell = WScript.CreateObject("WScript.Shell")  
Set WshNetwork = WScript.CreateObject("WScript.Network")  
Set objSysInfo = CreateObject("ADSystemInfo")   
 
strUserDN = objSysInfo.userName   
 
Set UserObj = GetObject("LDAP://" & strUserDN)   
 
For Each GroupObj In UserObj.Groups    
        UserGroups=UserGroups & "[" & GroupObj.Name & "]"    
Next    

'Выводим сообщение пользователю, при входе (принадлежность к группе) 
'MsgBox "Member of "& UserGroups    
 
if InGroup("PurchaseDeportament") then    
        MapDrv "O:", FileSrv1 & "\Purchase","Отдел закупок"        
end if   

if InGroup("SalesDeportament") then    
        MapDrv "X:", FileSrv1 & "\Public","Общий"
        MapDrv "O:", FileSrv1 & "\Sales","Отдел продаж"        
End If   

if InGroup("PrivateADM") then    
        MapDrv "X:", FileSrv1 & "\Public","Общий"
        MapDrv "O:", FileSrv1 & "\PubAdm","Администрация"
        MapDrv "P:", FileSrv1 & "\Sales","Отдел продаж"
        MapDrv "Z:", FileSrv1 & "\Purchase","Отдел закупок"
End If  

'Подключаем принтеры для всех пользователей
wshNetwork.AddWindowsPrinterConnection "\\comp15\HP_3050"
wshNetwork.AddWindowsPrinterConnection "\\comp8\HP_3055"

'Подключаем личный диск пользователя
MapDrv "L:", FileSrv1 & "\Private\" & WshNetwork.UserName, WshNetwork.UserName & "'s личный диск"
  
'==========================================================================  
'  
' Function MapDrv(DrvLet, UNCPath, DrvName)  
'  
' DrvLet - Буква устройства  
' UNCPath - Сетевой путь 
' DrvName - Название диска отображаемое в проводнике Windows 
'  
' COMMENT: Подключение сетевых дисков с записью ошибок в EventLog  
'  
'==========================================================================  
  
  
Function MapDrv(DrvLet, UNCPath, DrvName)  
  
    Dim objFSO, oShell          ' Object variable  
    Dim Msg  
  
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set oShell = CreateObject("Shell.Application") 
 
    On Error Resume Next  
 
    If objFSO.DriveExists(DrvLet) Then  
        WshNetwork.RemoveNetworkDrive DrvLet, true, true 
    End If 
 
    WshNetwork.MapNetworkDrive DrvLet, UNCPath 
    oShell.NameSpace(DrvLet).Self.Name = DrvName 
      
    Select Case Err.Number  
        Case 0            ' No error  
  
        Case -2147023694   
            WshNetwork.RemoveNetworkDrive DrvLet, true, true 
            WshNetwork.MapNetworkDrive DrvLet, UNCPath  
            oShell.NameSpace(DrvLet).Self.Name = DrvName 
               
        Case -2147024811   
            WshNetwork.RemoveNetworkDrive DrvLet, true, true  
            WshNetwork.MapNetworkDrive DrvLet, UNCPath  
            oShell.NameSpace(DrvLet).Self.Name = DrvName 
 
        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 & vbCrLf & vbCrLf  
            Msg = Msg & "Device name: " & DrvLet & vbCrLf  
            Msg = Msg & "Map path: " & UNCPath   
  
            WshShell.LogEvent 1, Msg, FileSrv1 
    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