Solved

vbscript to add share permissions

Posted on 2009-05-06
8
2,914 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
  • 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

Technology Partners: 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!

Question has a verified solution.

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

In this article we want to have a look at the directory attributes which are used by Microsoft to store the so called Security Identifiers (SID). These SIDs plays an important role in delegating and granting permissions and in authentication of trus…
This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…

749 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