Solved

vbscript to add share permissions

Posted on 2009-05-06
8
2,968 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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

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

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

Welcome, welcome!  If you are new to the series and haven't been following along, please take a brief moment to review the first three installments: Part 1 (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/A_266-VBScri…
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…
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…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …
Suggested Courses

623 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