asked on

Script that creates folders and shares as per the xls. Does not add the security permissions.

Hi,

Script that creates folders and shares as per the xls. Does not add the security permissions.
Every thing else works perfect
But just does not add the users/Groups to Security and add's to Share permissions correctly.

Regards
sharath

' Declare Constants
Const FILE_SHARE = 0
Const MAXIMUM_CONNECTIONS = True ' Set to a number to limit connections
Const ADS_SCOPE_BASE = 0 ' Search base object only
Const ADS_SCOPE_ONELEVEL = 1 ' Search one level of immediate children
Const ADS_SCOPE_SUBTREE = 2 ' Search target object and all sub levels
 
' Set Variables
strBaseFolder = "E:\Sres_HTA\"
strExcelPath = "C:\Shares\InputFile.xls"
iRow = 2 'Change this to 1 if there are no headers in the first row
DQ = Chr(34) ' Double Quote
 
' Create Objects
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
 
'Get current computer name
strComputer = objShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
 
' Create Array for users
Set arrUsers = CreateObject("System.Collections.ArrayList")
 
' Create Array for share permissions
Dim arrACE()
 
' Construct an ADsPath to the Current Domain with rootDSE
Set objRootDSE = GetObject("LDAP://rootDSE")
strADsPath = "LDAP://" & objRootDSE.Get("defaultNamingContext")
Set objSysInfo = CreateObject("ADSystemInfo")
strDomain = objSysInfo.DomainShortName
 
 
' Connect to Active Directory
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
 
' Create WMI object
Set objWMIService = _
GetObject("winmgmts:{impersonationLevel=impersonate,(Security)}!\\" & _
strComputer & "\root\cimv2")
 
' Open spreadsheet
Set objExcel = CreateObject("Excel.Application")
'objExcel.Visible = True
objExcel.Workbooks.Open strExcelPath
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
 
' Do all the tasks for each row until column A has an empty cell
Do While objSheet.Cells(iRow, 1).Value <> ""
	strFolder = strBaseFolder & Trim(objSheet.Cells(iRow, 1).Value) ' Column A
	strShare = Trim(objSheet.Cells(iRow, 1).Value) ' Column A
	strUser1 = Trim(objSheet.Cells(iRow, 2).Value) ' Column B
	strUser2 = Trim(objSheet.Cells(iRow, 3).Value) ' Column C
	strComment = Trim(objSheet.Cells(iRow, 4).Value) ' Column D
	
	WScript.Echo "Processing Folder: " & strFolder
	
	' If users are listed in B and C add them to the users array
	If strUser1 <> "" Then
		arrUsers.Add strUser1
	End If
	If strUser2 <> "" Then
		arrUsers.Add strUser2
	End If
	arrUsers.Add "Domain Admins"
	
	' Modify the Array for permissions
	intArraySize = arrUsers.Count - 1
	ReDim arrACE(intArraySize)
	
	' Create folder if it does not exist
	If Not objFSO.FolderExists(strFolder) Then
		objFSO.CreateFolder(strFolder)
	End If
	WScript.Echo VbTab & "Folder Created"
	
	' Share folder
	Set objNewShare = objWMIService.Get("Win32_Share")
	errReturn = objNewShare.Create(strFolder, strShare, FILE_SHARE, _
	MAXIMUM_CONNECTIONS, strComment )
	WScript.Echo VbTab & "Folder Shared"
	
	' Set share permissions
	Set SecDescClass = objWMIService.Get("Win32_SecurityDescriptor")
	Set SecDesc = SecDescClass.SpawnInstance_
	intCount = 0
	For Each strUser In arrUsers
		WScript.Echo VbTab & "Preparing user: " & strUser
	
		' Search AD for user
		objCommand.CommandText = _
		"SELECT objectSid,ADsPAth FROM '" & strADsPath & _
		"' WHERE sAMAccountName='" & strUser & "'"
		Set objRecordSet = objCommand.Execute
		
		' Verify user was found and get information
		If objRecordSet.EOF Then
			WScript.echo "User named " & strUser & " not found, Exiting script."
			WScript.quit
		Else
			objRecordSet.MoveFirst
			Do Until objRecordSet.EOF
				strUserSID = objRecordSet.Fields("objectSid").Value
				objRecordSet.MoveNext
			Loop
		End If
		
		' Convert objectSid to readable SID
		arrbytSid = strUserSID
		strHexSid = OctetToHexStr(arrbytSid)
		strDecSid = HexStrToDecStr(strHexSid)
		
		' Get SID attributes
		Set objSID = objWMIService.Get("Win32_SID='" & strDecSid & "'")
		
		' Creates an instance of a Windows Security Trustee and set data
		Set objTrustee = objWMIService.Get("Win32_Trustee").spawnInstance_
		With objTrustee
			.Domain = objSID.ReferencedDomainName
			.Name = objSID.AccountName
			.SID = objSID.BinaryRepresentation
			.SidLength = objSID.SidLength
			.SIDString = objSID.SID
		End With
		
		' Add SID attributes to permissions array
		Set arrACE(intCount) = objWMIService.Get("Win32_Ace").SpawnInstance_
		arrACE(intCount).Properties_.Item("AccessMask") = 2032127
		' 2032127 = "Full"; 1245631 = "Change"; 1179817 = "Read"
		arrACE(intCount).Properties_.Item("AceFlags") = 3
		arrACE(intCount).Properties_.Item("AceType") = 0 ' 0=allow 1=deny access
		arrACE(intCount).Properties_.Item("Trustee") = objTrustee
		
		' Advance counter for next array item
		intCount = intCount + 1
	Next
	
	' Assign permissions array as permissions to be set on share
	SecDesc.Properties_.Item("DACL") = arrACE
	
	' Connect to share and set share properties
	Set colShares = objWMIService.ExecQuery("Select * from " & _
	"Win32_Share Where Name = '" & strShare & "'")
	For Each objShare In colShares
		errReturn = objShare.SetShareInfo(MAXIMUM_CONNECTIONS, strComment, SecDesc)
		If errReturn = 0 Then
			WScript.Echo VbTab & "Share permissions updated"
		Else
			Select Case errReturn
				Case 2
					errDesc = "Access denied."
				Case 8
					errDesc = "Unknown failure."
				Case 9
					errDesc = "Invalid name."
				Case 10
					errDesc = "Invalid level."
				Case 21
					errDesc = "Invalid parameter."
				Case 22
					errDesc = "Duplicate share."
				Case 23
					errDesc = "Redirected path."
				Case 24
					errDesc = "Directory does not exist."
				Case 25
					errDesc = "Net name not found."
			End Select
			WScript.Echo VbTab & "Failed to update share permissions. " & _
			"Error number: " & errReturn & " - " & errDesc
		End If
	Next
	
	' Set NTFS permissions
	strUserNTFSPerms = " /t /c /g " & strDomain & "\" & strUser1 & ":F " & _
	strDomain & "\" & strUser2 & ":F " & DQ & strDomain & _
	"\Domain Admins" & DQ & ":F /y"
	
	intRunError = objShell.Run("%COMSPEC% /c xcacls " & DQ & strFolder & DQ & _
	strUserNTFSPerms, 2, True)
		
	If intRunError <> 0 Then
	WScript.Echo VbTab & "Failed to update NTFS permissions. " & _
	"Error number: " & errReturn
	Else
		WScript.Echo VbTab & "NTFS permissions updated"
	End If
	
	'Prepare for next folder
	WScript.Echo
	iRow = iRow + 1
	arrUsers.Clear()
	Erase arrACE
Loop
 
' Close excel
objExcel.DisplayAlerts = False
objExcel.Workbooks.Close
 
 
' Functions are below
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
Function OctetToHexStr(ByVal arrbytOctet)
	' Function to convert OctetString (byte array) to Hex string.
	OctetToHexStr = ""
	For k = 1 To Lenb(arrbytOctet)
		OctetToHexStr = OctetToHexStr & Right("0" & _
		Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
	Next
End Function
 
Function HexStrToDecStr(strSid)
	' Function to convert most hex SID values to decimal format.
	Dim arrbytSid
	ReDim arrbytSid(Len(strSid) / 2 - 1)
	For j = 0 To UBound(arrbytSid)
		arrbytSid(j) = CInt("&H" & Mid(strSid, 2 * j + 1, 2))
	Next
	If (UBound(arrbytSid) = 11) Then
		HexStrToDecStr = "S-" & arrbytSid(0) & "-" _
		& arrbytSid(1) & "-" & arrbytSid(8)
		
		Exit Function
	End If
	If (UBound(arrbytSid) = 15) Then
		HexStrToDecStr = "S-" & arrbytSid(0) & "-" _
		& arrbytSid(1) & "-" & arrbytSid(8)
		lngTemp = arrbytSid(15)
		lngTemp = lngTemp * 256 + arrbytSid(14)
		lngTemp = lngTemp * 256 + arrbytSid(13)
		lngTemp = lngTemp * 256 + arrbytSid(12)
		HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)
		Exit Function
	End If
	HexStrToDecStr = "S-" & arrbytSid(0) & "-" _
	& arrbytSid(1) & "-" & arrbytSid(8)
	lngTemp = arrbytSid(15)
	lngTemp = lngTemp * 256 + arrbytSid(14)
	lngTemp = lngTemp * 256 + arrbytSid(13)
	lngTemp = lngTemp * 256 + arrbytSid(12)
	HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)
	lngTemp = arrbytSid(19)
	lngTemp = lngTemp * 256 + arrbytSid(18)
	lngTemp = lngTemp * 256 + arrbytSid(17)
	lngTemp = lngTemp * 256 + arrbytSid(16)
	HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)
	lngTemp = arrbytSid(23)
	lngTemp = lngTemp * 256 + arrbytSid(22)
	lngTemp = lngTemp * 256 + arrbytSid(21)
	lngTemp = lngTemp * 256 + arrbytSid(20)
	HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)
	If (UBound(arrbytSid) > 23) Then
		lngTemp = arrbytSid(25)
		lngTemp = lngTemp * 256 + arrbytSid(24)
		HexStrToDecStr = HexStrToDecStr & "-" & CStr(lngTemp)
	End If
End Function

Open in new window

markdmac

What OS is this running against? Server 2003 or Server 2008?

bsharath

ASKER

Hi mark,
Windows server 2003

markdmac

OK, that makes life simple. I want to be clear about the data the spreadsheet has in it.

Column A = Folder location
Column B = First user to grant rights to
Column C = Second user to grant rights to
Column D = Comment for the share

Unclear to me is:
1. If Column A has the full path to the folder or if there should be a base path to start at.
2. Should the share match the folder name
3. Looks like that script added domain admins but how about a need for System?
4. Will the script always be run on the server where the shares will be created?

bsharath

ASKER

Hi Mark,
1. It will have just the folder name
2. Folder is created and shared in the mentioned path in the script
3. Yes i guess we need to add that by default
4. Yes always on the server

bsharath

ASKER

Hi Mark an views...

ASKER CERTIFIED SOLUTION

RobSampson

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

bsharath

ASKER

Thanks a lot Rob... :-)