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

[AlexStud]

Есть функция, должна создавать домашнюю папку (разрешения только пользователю - владельцу и пара служебных аккаунтов) на удаленном сервере и назначать залогиненому пользователю разрешения (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)?

[amel27]

1. с правами пользователя (под System - политика "на компьютер" StartUp/Shutdown);

2. пользователю или его группе - на чтение+создание каталогов в корне, владельцу - полный;

3. только под другой учеткой;

4.

перенаправление папок

пользователя.