Submitted By: Anonymous Submission

Creates a series of shared folders (as specified in a text file), creates four security groups per share, and then assigns the appropriate access permissions to those groups.

Visual Basic
Edit|Remove
option explicit

'Constant Location
Const Path = "c:\shares\"
Const ADLocatDLG = "OU=DLG,OU=Sec_Groups, dc=apie, dc=be"
Const ADLocatGG = "OU=GG,OU=Sec_Groups, dc=apie, dc=be"
Const ADS_PROPERTY_APPEND = 3


'Variables
Dim objFSO1
Dim objTxtF
Dim objFSO2
Dim objFolder
Dim Sharename
Dim objOU
Dim objGroup
Dim Locat
Dim strComputer
Dim objWMIService
Dim objNewShare
Dim errReturn
Dim DLG_RWXD
Dim DLG_RX
Dim GG_RWXD
Dim GG_RX
DIM objShell


'Group types
Const ADS_GROUP_TYPE_DLG = &H4
Const ADS_GROUP_TYPE_GLOBAL_GROUP = &H2
Const ADS_GROUP_TYPE_SECURITY_ENABLED = &H80000000


'Read the name of the folder from notepad file
Locat = "c:\final\folders.txt"
Set objFSO1 = CreateObject("Scripting.FileSystemObject")
Set objTxtF = objFSO1.OpenTextFile(Locat, 1)

strComputer = "."

Do While objTxtF.AtEndOfStream <> True

	
	'Create the folder and share it
	ShareName = objTxtF.ReadLine
	Set objFSO2 = CreateObject("Scripting.FileSystemObject")
	Set objFolder = objFSO2.CreateFolder(Path & sharename)
	Set objWMIService = Getobject("winmgmts:" _
		& "{impersonationlevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set objNewShare = objWMIService.Get("Win32_Share")
	errReturn = objNewShare.Create _
		(Path & sharename, sharename, 0)


	'Create the DLG
	Set objOU = GetObject("LDAP://" & ADLocatDLG)
	DLG_RWXD = "DLG_" & ShareName & "_RWXD"
	DLG_RX = "DLG_" & ShareName & "_RX"

	'RWXD
	Set objGroup = objOU.Create("Group", "cn=" & DLG_RWXD)
	objGroup.Put "sAMAccountName", DLG_RWXD
	objGroup.Put "groupType", ADS_GROUP_TYPE_DLG Or _
	          ADS_GROUP_TYPE_SECURITY_ENABLED
	objGroup.SetInfo
    
	'RX
	Set objGroup = objOU.Create("Group", "cn=" & DLG_RX)
	objGroup.Put "sAMAccountName", DLG_RX
	objGroup.Put "groupType", ADS_GROUP_TYPE_DLG Or _
		ADS_GROUP_TYPE_SECURITY_ENABLED
	objGroup.SetInfo
	

	'Create the GG
	Set objOU = GetObject("LDAP://" & ADLocatGG)
	GG_RWXD = "GG_" & ShareName & "_RWXD"
	GG_RX = "GG_" & ShareName & "_RX"
    
	'RWXD
	Set objGroup = objOU.Create("Group", "cn=" & GG_RWXD)
	objGroup.Put "sAMAccountName", GG_RWXD
	objGroup.Put "groupType", ADS_GROUP_TYPE_GLOBAL_GROUP Or _
		ADS_GROUP_TYPE_SECURITY_ENABLED
	objGroup.SetInfo
  
	'RX
	Set objGroup = objOU.Create("Group", "cn=" & GG_RX)
	objGroup.Put "sAMAccountName", GG_RX
	objGroup.Put "groupType", ADS_GROUP_TYPE_GLOBAL_GROUP Or _
		ADS_GROUP_TYPE_SECURITY_ENABLED
	objGroup.SetInfo


	'Add the GG to DLG
	
	'RWXD
	Set objGroup = GetObject _
		("LDAP://cn=" & DLG_RWXD & "," & ADLocatDLG)
	objGroup.PutEx ADS_PROPERTY_APPEND, "member", _
		Array("cn=" & GG_RWXD & "," & ADLocatGG)
	objGroup.SetInfo
	
	'RX
	Set objGroup = GetObject _
		("LDAP://cn=" & DLG_RX & "," & ADLocatDLG)
	objGroup.PutEx ADS_PROPERTY_APPEND, "member", _
		Array("cn=" & GG_RX & "," & ADLocatGG)
	objGroup.SetInfo

	
	'Correct the security for the share on NTFS-permission
	Set objShell = CreateObject("Wscript.Shell")
	objShell.run("cmd /c echo y| cacls " & path & sharename & " /t /g " & DLG_RWXD &_
     ":C " & DLG_RX & ":R "& """domain admins""" & ":F")

Loop

Set objFSO1 = nothing
Set objTxtF = nothing
Set objFSO2 = nothing
Set objFolder = nothing
Set objOU = nothing
Set objGroup = nothing
Set objWMIService = nothing
Set objNewShare = nothing

wscript.echo "De groepen werden aangemaakt"
wscript.Quit