Solved

vbscript to add share permissions

Posted on 2009-05-06
8
2,935 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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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 500 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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

I met Paul Devereux (@pdevereux) today when I responded to his tweet asking “Anybody know how to automate adding files from disk to a folder in #outlook  ?”.  I replied back and told Paul that using automation, in this case scripting, to add files t…
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…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
How to Install VMware Tools in Red Hat Enterprise Linux 6.4 (RHEL 6.4) Step-by-Step Tutorial
Suggested Courses

738 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