VBS/WSH/JS - Создание папки домашней пользователя логон-скриптом. Есть вопрос.

VBS/WSH/JS - Создание папки домашней пользователя логон-скриптом. Есть вопрос.

AlexStud

Новый участник

Сообщения: 10
Благодарности: 0

Изменения

Автор: AlexStud
Дата: 20-03-2009

Есть функция, должна создавать домашнюю папку (разрешения только пользователю - владельцу и пара служебных аккаунтов) на удаленном сервере и назначать залогиненому пользователю разрешения (Full). Под админом работает на ура, при логине обычного пользователя (логон скрипт в GP) не отрабатывает... Пишет Permission Denied...

'=================================================================================================== ===================
' VBScript Source File
' NAME: logon-script-v1.00.vbs
' VERSION: v1.01
' COMMENT: Добавленно мапирование папок "Общая", "Персональный диск пользователя"
' COMMENT:
' COMMENT:
' COMMENT:
' COMMENT:
' COMMENT:
' COMMENT:
' COMMENT:
' Заметки:
'=================================================================================================== ===================
Option Explicit
'On Error Resume Next

Dim WshShell, WshNetwork
Dim strUserDN, objSysInfo, GroupObj, UserGroups, UserObj, UserName

' Задаем имя файлового сервера, при использовании нескольких серверов создаем несколько констант и используем их при вызове MapDrv
'Const FileSrv1 = "\\fs.osmp"
Const FileSrv2 = "\\v-osmp-fs01"
Const FileSrv3 = "\\v-osmp-fs02"
' Const FileSrv4 = "\\srv.name"

'Const PathToFld1 = "\UsersZ$\"

UserGroups=""
UserName=""

Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set objSysInfo = CreateObject("ADSystemInfo")

UserName = WshNetwork.UserName
strUserDN = objSysInfo.UserName

Set UserObj = GetObject("LDAP://" & strUserDN)

For Each GroupObj In UserObj.Groups
UserGroups=UserGroups & "[" & GroupObj.Name & "]"
Next

'MsgBox "Member of "& UserGroups
'#####################################################################
'Подключаем диск W - общий для всех (fs.osmp)
'if InGroup("all-osmp-users") then
' MapDrv "W:", FileSrv1 & "\X","Общие папки отделов (fs)"
'end If
'#####################################################################
'Подключаем диск X - общий для всех (v-osmp-fs01.usrp.rt.local)
if InGroup("all-osmp-users") then
MapDrv "X:", FileSrv2 & "\diskx","Общие папки отделов"
end If

'#####################################################################
if InGroup("Администраторы домена") Then
CreateFld FileSrv3, "\UsersZ$\" & UserName
SetPermissions FileSrv3, "\UsersZ$\" & UserName, UserName, "USRP\"
MapDrv "Z:", FileSrv3 & "\UsersZ$\" & UserName, "Security"
End If

'==========================================================================

'MapDrv "L:", FileSrv2 & "\Users$\" & WshNetwork.UserName, & "Персональный диск " & WshNetwork.UserName
MapDrv "P:", FileSrv2 & "\Public", "Общая для всех"
'MapDrv "R:", FileSrv1 & "\Archive", "Архив"
'MapDrv "U:", FileSrv1 & "\Users","All Users"
'MapDrv "W:", FileSrv1 & "\Work","Проекты"
'=================================================================================================== ===================
'
' Function CreateLnk(FldLnkPath, LnkPath, LnkName)
'
' FldLnkPath - Сетевой путь к папке
' LnkPath - Имя файла программы
' LnkName - Имя линка
' LnkDesc - Комментарий
'
' COMMENT: Подключение сетевых дисков с записью ошибок в EventLog
'
'=================================================================================================== ===================

'Function CreateLnk(FldLnkPath, LnkPath, LnkName, LnkDesc)

' Dim DesktopPath, Shortcut
' DesktopPath = WshShell.SpecialFolders("Desktop")
' Set Shortcut = WshShell.CreateShortcut(DesktopPath & LnkName)
' On Error Resume Next

' Shortcut.TargetPath = WshShell.ExpandEnvironmentStrings(FldLnkPath & LnkPath)
' Shortcut.WorkingDirectory =WshShell.ExpandEnvironmentStrings(FldLnkPath)
' Shortcut.WindowStyle = 1
' Shortcut.IconLocation = WshShell.ExpandEnvironmentStrings(FldLnkPath & LnkPath & ", 0")
' Shortcut.Description = LnkDesc
' Shortcut.Save

'End Function

'=================================================================================================== ===================
'
' Function MapDrv(DrvLet, UNCPath, DrvName)
'
' DrvLet - Буква устройства
' UNCPath - Сетевой путь
' DrvName - Название диска отображаемое в проводнике Windows
'
' COMMENT: Подключение сетевых дисков с записью ошибок в EventLog
'
'=================================================================================================== ===================

Function MapDrv(DrvLet, UNCPath, DrvName)

Dim objFSO, oShell, objMsg ' Object variable
Dim Msg
Dim SMTPServer, Recipient, From, Subject, Message

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Shell.Application")
Set objMsg = WScript.CreateObject("CDO.Message")

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
Msg = "Mapping network drive success! Error number: " & CStr(Err.Number) & " (0x" & Hex(Err.Number) & ")" & vbCrLf & "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

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
'==========================================================================

'==========================================================================

' Function CreateFolder(PathToSrv, PathToFld)
'
' PathToSrv - путь к серверу
' PathToFld - путь к папке
' COMMENT: Создаем папку в сети (\\server\folder\)
'==========================================================================
Function CreateFld(PathToSrv, PathToFld)

Dim objFSO, objFolder

Set objFSO = CreateObject("Scripting.FileSystemObject")

If Not objFSO.FolderExists( PathToSrv & PathToFld ) Then
Set objFolder = objFSO.CreateFolder( PathToSrv & PathToFld )
End If

End Function
'==========================================================================

'==========================================================================
' Function SetPermissions(Путь_к_серверу, путь_к_папке, имя_пользователя, домен)
' PathToSrv - Путь к серверу (например: FileSrv1)
' PthToFld - Путь к папке (например: "\UserZ$\")
' UsrName - Имя пользователя (например: a.mouzhagitov)
' Domain - Используемый домен (например USRP)
' COMMENT: В аргументе функции указываем путь к серверу и к папке (путь составной), также необходимо указать имя пользователя с доменом (можно автоматизировать)
'==========================================================================
Function SetPermissions(PathToSrv, PathToFld, UsrName, Domain)
Dim strCmd, objShell, objFSO

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FolderExists(PathToSrv & PathToFld) Then
strCmd = objShell.Run("%COMSPEC% /k cacls """ & PathToSrv & PathToFld & """ /E /G """ & Domain & UsrName & """:F ", 2, True)
End If

End Function
'==========================================================================

Вопросы:

1. Подскажите, плз, под какой учеткой запускается логон скрипт в GP на пользователя, System? Пробовал дать на систем полный доступ, не аллё?
2. Какие NTFS разрешения надо дать на корневой каталог (на шару дал Full пользователям домена) домашних папок, чтобы создать из-под GP логон скриптом папку, лишние разрешения потом тем же скриптом можно и удалить?
3. Возможно можно запускать скрипт с повышенными привилегиями?
4. Какие возможны еще вариаты для реализации задачи? (хочется все сделать одним vbscript'om)?

Отправлено: 12:41, 20-03-2009

amel27

Googler

Сообщения: 3665
Благодарности: 1563

Профиль | Отправить PM | Цитировать

1. с правами пользователя (под System - политика "на компьютер" StartUp/Shutdown);
2. пользователю или его группе - на чтение+создание каталогов в корне, владельцу - полный;
3. только под другой учеткой;
4. перенаправление папок пользователя.

Отправлено: 16:38, 20-03-2009 | #2

Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля.