Solved

vbscript to add share permissions

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

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
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

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…
Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

758 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

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now