Solved

vbscript to add share permissions

Posted on 2009-05-06
8
2,836 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Unlike scripting languages such as C# where a semi-colon is used to indicate the end of a command, Microsoft's VBScript language relies on line breaks to determine when a command begins and ends. As you can imagine, this quickly results in messy cod…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Windows 10 is mostly good. However the one thing that annoys me is how many clicks you have to do to dial a VPN connection. You have to go to settings from the start menu, (2 clicks), Network and Internet (1 click), Click VPN (another click) then fi…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

867 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

16 Experts available now in Live!

Get 1:1 Help Now