I found a script that creates a folder for a user and sets ntfs permissions
for the folder, and shares the folder out, but is also supposed to set the
share permissions for the folder, however it doesn't seem to set them ?
Does anyone know why the setting of the share permissions doesn't work or
how to fix it ?
'=====================================================
Option Explicit
Dim objFSO, objFolder, objShell, objWMIService, objNewShare
Dim strUsername, strComputer, strDirectory, errReturn, intRunError
Dim Trustee, ACE, SecDesc, SecDescClass, Services
Const FILE_SHARE = 0
Const MAXIMUM_CONNECTIONS = 25
FolderCreate
CreateShare
NTFSPermissions
PermissionShare
'=====================================================
Sub FolderCreate ()
' Get Folder name
strUsername = InputBox("Enter User ID")
strDirectory = "C:\" & strUsername
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Note If..Exists. Then, Else ... End If construction
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
WScript.Echo strDirectory & " already created "
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
WScript.Echo "Just created " & strDirectory
End If
If err.number = vbEmpty then
Set objShell = CreateObject("WScript.Shell")
objShell.run ("Explorer" &" " & strDirectory & "\" )
Else
WScript.echo "VBScript Error: " & err.number
End If
End Sub
'=====================================================
Sub CreateShare ()
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objNewShare = objWMIService.Get("Win32_Share")
errReturn = objNewShare.Create _
(strDirectory, strUsername & "$", FILE_SHARE, _
MAXIMUM_CONNECTIONS, "3rd Party H: drive")
End Sub
'=================================================
Sub NTFSPermissions ()
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strDirectory) Then
' Assign user permission to home folder.
intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls " _
& strDirectory & " /t /c /g Administrators:F ",2,True)
intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls " _
& strDirectory & " /e /c /g ""Domain Admins"":F ",2,True)
intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls " _
& strDirectory & " /e /c /g " & strUsername & ":C ",2,True)
If intRunError <> 0 Then
Wscript.Echo "Error assigning permissions for user " _
& strUsername & " to home folder " & strDirectory
End If
End If
End Sub
'=====================================================
Sub PermissionShare()
Set Services =
GetObject("WINMGMTS:{impersonationLevel=impersonate,(Security)}!\\" &
strComputer & "\ROOT\CIMV2")
Set SecDescClass = Services.Get("Win32_SecurityDescriptor")
Set SecDesc = SecDescClass.SpawnInstance_()
Set Trustee = Services.Get("Win32_Trustee").SpawnInstance_
Trustee.Domain = Null
Trustee.Name = "Administrators"
Trustee.Properties_.Item("SID") = Array(1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0)
Set ACE = Services.Get("Win32_Ace").SpawnInstance_
ACE.Properties_.Item("AccessMask") = 2032127
ACE.Properties_.Item("AceFlags") = 3
ACE.Properties_.Item("AceType") = 0
ACE.Properties_.Item("Trustee") = Trustee
SecDesc.Properties_.Item("DACL") = Array(ACE)
End Sub
'=====================================================
WScript.Quit
Bookmarks