Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

vbscript to add share permissions

Posted on 2009-05-06
8
Medium Priority
?
3,005 Views
Last Modified: 2012-05-06
Hi,
I have a vbscript which creates folders from usernames listed in a text file and then it adds each particular username to the created folders security permissions giving them read and write access.

Because I'm such a noob when it comes to vbscripting and don't have a huge idea about programming, I also want the script to share the newly created folder. Giving share permissions of that being the named folder.
eg. Folder is created call student1 and is shared with share name student1, giving them read and write access.

Is it possible to change the following script to do that?

It would be very muchly appreciated if someone could help out.

Regards


Option Explicit
Dim strHomeFolder, strHome, strUser
Dim objFSO, objShell, intRunError
Dim oFSO, sFile, oFile, sText
 
' Note you will have to amend the following variables
strHome = "D:\Users\"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFile = "D:\Users\users.txt"
 
' Create a shell for cmd and CACLS
Set objShell = CreateObject("Wscript.Shell")
 
' Here is the loop that cycles through the cells
If oFSO.FileExists(sFile) Then
  Set oFile = oFSO.OpenTextFile(sFile, 1)
  Do While Not oFile.AtEndOfStream
    sText = oFile.ReadLine
    If Trim(sText) <> "" Then
      strUser = sText
      call HomeDir ' I decided to use a subroutine
    End If
  Loop
  oFile.Close
Else
  WScript.Echo "The file was not there."
End If
 
 
Sub HomeDir()
  strHomeFolder = strHome & strUser
  If strHomeFolder <> "" Then
    If Not objFSO.FolderExists(strHomeFolder) Then
      On Error Resume Next
      objFSO.CreateFolder strHomeFolder
      If Err.Number <> 0 Then
        On Error GoTo 0
        Wscript.Echo "Cannot create: " & strHomeFolder
      End If
      On Error GoTo 0
    End If
    If objFSO.FolderExists(strHomeFolder) Then
      ' Assign user permission to home folder.
      intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls "_
      & strHomeFolder & " /E /c /g " & strUser & ":C" , 2, True)
      If intRunError <> 0 Then
        Wscript.Echo "Error assigning permissions for user " _
        & strUser & " to home folder " & strHomeFolder
      End If
    End If
  End If
End Sub
 
WScript.Quit

Open in new window

0
Comment
Question by:gotafe
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
8 Comments
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24325559
I have made some adjustments to your script.  Try the attached and let me know.

Option Explicit
Dim strHomeFolder, strHome, strUser
Dim objFSO, objShell, intRunError, objWMIService
Dim oFSO, sFile, oFile, strComputer, objShare
 
' Note you will have to amend the following variables
strComputer = "."	' Sets to use current PC
strHome = "D:\Users\"
sFile = "D:\Users\users.txt"
Const FILE_SHARE = 0
Const MAXIMUM_CONNECTIONS = 10	
 
'  Instantiate objects 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Create a shell for cmd and CACLS
Set objShell = CreateObject("Wscript.Shell")
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objShare = objWMIService.Get("Win32_Share")
 
' Here is the loop that cycles through the cells
If oFSO.FileExists(sFile) Then
  Set oFile = oFSO.OpenTextFile(sFile, 1)
  Do While Not oFile.AtEndOfStream
    strUser = oFile.ReadLine
    If Trim(strUser) <> "" Then call HomeDir ' I decided to use a subroutine
  Loop
  oFile.Close
Else
  WScript.Echo "The file was not there."
End If
 
wscript.quit
 
Sub HomeDir()
  strHomeFolder = strHome & strUser
    If Not objFSO.FolderExists(strHomeFolder) Then
      On Error Resume Next
      objFSO.CreateFolder strHomeFolder
      If Err.Number <> 0 Then
        On Error GoTo 0
        Wscript.Echo "Cannot create: " & strHomeFolder
      End If
      On Error GoTo 0
    End If
 
	' Assign user permission to home folder.
	intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls "_
      & strHomeFolder & " /E /c /g " & strUser & ":C" , 2, True)
    If intRunError <> 0 Then
		Wscript.Echo "Error assigning permissions for user " _
        & strUser & " to home folder " & strHomeFolder
    End If
	
	' Share Folder
	' Options are (folderpath, sharename, FileShareflag,
	'	MaximumNumberOfUserConnections, Comments)
	errReturn = objNewShare.Create _
    (strHomeFolder, strUser, FILE_SHARE, _
        MAXIMUM_CONNECTIONS, "My Shared Folder or whatever you want")
	If errReturn <> 0 Then
		wscript.echo "Error sharing " & strHomeFolder
	End if
	
End Sub

Open in new window

0
 

Author Comment

by:gotafe
ID: 24331545
I get an error on Line 59 char 9 saying Error : Object required: 'objNewShare'
Code : 800A01A8, Microsoft VBScript Runtime Error.

It then stops and only creates one folder, but it isn't shared.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24331854
Sorry, had a typo.  Try this code.

-Bear

Option Explicit
Dim strHomeFolder, strHome, strUser
Dim objFSO, objShell, intRunError, objWMIService
Dim oFSO, sFile, oFile, strComputer, objShare
 
' Note you will have to amend the following variables
strComputer = "."       ' Sets to use current PC
strHome = "D:\Users\"
sFile = "D:\Users\users.txt"
Const FILE_SHARE = 0
Const MAXIMUM_CONNECTIONS = 10  
 
'  Instantiate objects 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Create a shell for cmd and CACLS
Set objShell = CreateObject("Wscript.Shell")
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objShare = objWMIService.Get("Win32_Share")
 
' Here is the loop that cycles through the cells
If oFSO.FileExists(sFile) Then
  Set oFile = oFSO.OpenTextFile(sFile, 1)
  Do While Not oFile.AtEndOfStream
    strUser = oFile.ReadLine
    If Trim(strUser) <> "" Then call HomeDir ' I decided to use a subroutine
  Loop
  oFile.Close
Else
  WScript.Echo "The file was not there."
End If
 
wscript.quit
 
Sub HomeDir()
  strHomeFolder = strHome & strUser
    If Not objFSO.FolderExists(strHomeFolder) Then
      On Error Resume Next
      objFSO.CreateFolder strHomeFolder
      If Err.Number <> 0 Then
        On Error GoTo 0
        Wscript.Echo "Cannot create: " & strHomeFolder
      End If
      On Error GoTo 0
    End If
 
        ' Assign user permission to home folder.
        intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls "_
      & strHomeFolder & " /E /c /g " & strUser & ":C" , 2, True)
    If intRunError <> 0 Then
                Wscript.Echo "Error assigning permissions for user " _
        & strUser & " to home folder " & strHomeFolder
    End If
        
        ' Share Folder
        ' Options are (folderpath, sharename, FileShareflag,
        '       MaximumNumberOfUserConnections, Comments)
        errReturn = objShare.Create _
    (strHomeFolder, strUser, FILE_SHARE, _
        MAXIMUM_CONNECTIONS, "My Shared Folder or whatever you want")
        If errReturn <> 0 Then
                wscript.echo "Error sharing " & strHomeFolder
        End if
        
End Sub

Open in new window

0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:gotafe
ID: 24332232
Hi,
Its working, nearly. I had to also go Dim errReturn and declare that variable and it worked.

Whats happening now though, is that the share permissions for each folder is set to 'Everyone' with full control. I want it set to the user instead.  Eg. Folder is created called student1 and is shared as student1 with the share permissions of 'student1' with change permissions.

If that makes any sense.

Regards
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24332829
I am working on the changes but it takes some more code.  I should have something tomorrow.

-Bear
0
 
LVL 20

Accepted Solution

by:
ltlbearand3 earned 2000 total points
ID: 24337013
Ok, I have adjusted the script to set the folder permissions to the username.  Now to set this, the script must have either the domain of the user or the local PC name.  We need this to look up the SID which is required for setting folder permisions (Windows requires that the user being given permisions have been validated as a user).  Just set strUserDomain as your Domain and it should work.  Let me know.

-Bear


Option Explicit
Dim strHomeFolder, strHome, strUser
Dim objFSO, objShell, intRunError, objWMIService
Dim oFSO, sFile, oFile, strComputer, objShare
Dim errReturn, strUserDomain
 
' Note you will have to amend the following variables
strComputer = "."       ' Sets to use current PC
strUserDomain = "DOMAIN"	' Can also put in local machine name
strHome = "D:\Users\"
sFile = "D:\Users\users.txt"
Const FILE_SHARE = 0
Const MAXIMUM_CONNECTIONS = 10  
 
'  Instantiate objects 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Create a shell for cmd and CACLS
Set objShell = CreateObject("Wscript.Shell")
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objShare = objWMIService.Get("Win32_Share")
 
' Here is the loop that cycles through the cells
If oFSO.FileExists(sFile) Then
  Set oFile = oFSO.OpenTextFile(sFile, 1)
  Do While Not oFile.AtEndOfStream
    strUser = oFile.ReadLine
    If Trim(strUser) <> "" Then call HomeDir ' I decided to use a subroutine
  Loop
  oFile.Close
 Else
 	strUser = "EETest"
	CAll HomeDir
 WScript.Echo "The file was not there."
End If
 
wscript.quit
 
Sub HomeDir()
  strHomeFolder = strHome & strUser
    If Not objFSO.FolderExists(strHomeFolder) Then
      On Error Resume Next
      objFSO.CreateFolder strHomeFolder
      If Err.Number <> 0 Then
        On Error GoTo 0
        Wscript.Echo "Cannot create: " & strHomeFolder
      End If
      On Error GoTo 0
    End If
 
	' Share Folder
    SetSharePermission strUserDomain, strUser, strHomeFolder, "HomeFolderShare"
	
	' Assign user permission to home folder.
	intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls "_
      & strHomeFolder & " /E /c /g " & strUser & ":C" , 2, True)
    If intRunError <> 0 Then
                Wscript.Echo "Error assigning permissions for user " _
        & strUser & " to home folder " & strHomeFolder
    End If
End Sub
 
Sub SetSharePermission(strDomain, strFolderName, strPath, strDescription)
	' strFolderName is assumed to be same as username
	Dim objWMISecurity, objDescriptor, objSecurityDesc, objTrustee
	Dim objAccount, objAccountSID, ACE, InParam
 
	Set objWMISecurity = GetObject("winmgmts:" _
		& "{impersonationLevel=impersonate,(Security)}!\\" & strComputer & "\ROOT\CIMV2")
	Set objDescriptor = objWMIService.Get("Win32_SecurityDescriptor")
	Set objSecurityDesc = objDescriptor.SpawnInstance_()
	set objTrustee = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Trustee").Spawninstance_
	set objAccount = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Account.Name='" & strFolderName & "',Domain='" & strDomain &"'")
	set objAccountSID = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_SID.SID='" & objAccount.SID &"'")
	objTrustee.Domain = strDomain
	objTrustee.Name = strFolderName
	objTrustee.Properties_.item("SID") = objAccountSID.BinaryRepresentation
	Set ACE = objWMIService.Get("Win32_Ace").SpawnInstance_
	ACE.Properties_.Item("AccessMask") = 2032127 '2032127 = "Full"; 1245631 = "Change"; 1179817 = "Read"
	ACE.Properties_.Item("AceFlags") = 3
	ACE.Properties_.Item("AceType") = 0
	ACE.Properties_.Item("Trustee") = objTrustee
	objSecurityDesc.Properties_.Item("DACL") = Array(ACE)
	Set InParam = objShare.Methods_("Create").InParameters.SpawnInstance_()
	InParam.Properties_.Item("Access") = objSecurityDesc
	InParam.Properties_.Item("Description") = strDescription
	InParam.Properties_.Item("Name") = strFolderName
	InParam.Properties_.Item("Path") = strPath
	InParam.Properties_.Item("Type") = FILE_SHARE
	InParam.Properties_.Item("MaximumAllowed") = MAXIMUM_CONNECTIONS 
	objShare.ExecMethod_ "Create", InParam
End Sub

Open in new window

0
 

Author Comment

by:gotafe
ID: 24350527
You, sir, are worth your weight in gold.
Its working brilliantly.

Thank you so very very much.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 24350550
Your Welcome.
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Well hello again!  Glad to see you've made it this far without giving up.  In this, the fourth installment of my popular series, I'm going to cover functions and subroutines, what they are, and why they are useful.  Just in case you stumbled onto th…
This script will sweep a range of IP addresses (class c only, 255.255.255.0) and report to a log the version of office installed. What it does: 1.)      Creates log file in the directory the script is run from (if it doesn't already exist) 2.)      Sweep…
In this brief tutorial Pawel from AdRem Software explains how you can quickly find out which services are running on your network, or what are the IP addresses of servers responsible for each service. Software used is freeware NetCrunch Tools (https…
In this video, Percona Solutions Engineer Barrett Chambers discusses some of the basic syntax differences between MySQL and MongoDB. To learn more check out our webinar on MongoDB administration for MySQL DBA: https://www.percona.com/resources/we…

670 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question