"Steve Furniss" <SteveFurn***@discussions.microsoft.com> wrote in message
news:0C477D30-B97A-40D1-82ED-6E0D85F93935@microsoft.com...
>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