#57306 - 2002-11-14 11:11 PM
Re: How Do I move shares-permissions NT4 to 2000
|
Lonkero
KiX Master Guru
   
Registered: 2001-06-05
Posts: 22346
Loc: OK
|
got it, thanks to one great tool named postprep
code: '*********************************************************************************** '* '* File: XCACLS.VBS '* Created: April 18, 2001 '* Last Modified: February 26, 2002 '* Version: 2.7 '* '* Main Function: List/Change ACLS for files and directories '* '* '* Copyright (C) 2001 Microsoft Corporation '* '* Written by David B '* '***********************************************************************************
OPTION EXPLICIT
'******************************************************************** '* Declare main variables '********************************************************************
Dim intOpMode, blnQuiet, strOutputFile, objOutputFile, debug_on Dim a_Used, t_Used, e_Used, g_Used, r_used Dim p_Used, d_used, i_used, o_used, filename_var Dim l_Used, q_Used, debug_Used, strDefaultDomain, strSystemDomainSid, strSystemDomainName, intPermUpdateCount Dim g_var_User(), ObjTrustee_g_var_User(), g_Var_Perm(), g_Var_Spec() dim r_Var_User(), ObjTrustee_r_var_User() Dim p_var_User(), ObjTrustee_p_var_User(), p_Var_Perm(), p_Var_Spec() Dim d_Var_User(), ObjTrustee_d_var_User(), d_Var_Perm(), d_Var_Spec() ReDim g_var_User(0), ObjTrustee_g_var_User(0), g_Var_Perm(0), g_Var_Spec(0) Redim r_Var_User(0), ObjTrustee_r_var_User(0) ReDim p_var_User(0), ObjTrustee_p_var_User(0), p_Var_Perm(0), p_Var_Spec(0) ReDim d_Var_User(0), ObjTrustee_d_var_User(0), d_Var_Perm(0), d_Var_Spec(0) Dim i_Var, o_Var Dim fso, InitialfilenameAbsPath, QryBaseNameHasWildcards, QryExtensionHasWildcards Dim objService, objLocalService, objLocator Dim strRemoteServerName, strRemoteShareName, strRemoteUserName, strRemotePassword Dim RemoteServer_Used, RemoteUserName_Used Dim DisplayDirPath, ActualDirPath Dim BoolUsingCScript Dim endTime, startTime
'This const value is for any use referenced without a domain, if this is TRUE, we will use the local machine name 'for the domain if its a non-dc. For DC's we will always use the Domain name unless you specify the actual domain to use. 'If this is FALSE, we will default to the Domain name.
CONST CONST_USE_LOCAL_FOR_NON_DCs = TRUE
'These are specific to this Script CONST CONST_SHOW_USAGE = 3 CONST CONST_PROCEED = 4 CONST CONST_ERROR = 1
'When working with NTFS Security, we use constants that match the API documentation '********************* ControlFlags ********************* CONST ALLOW_INHERIT = 33796 'Used in ControlFlag to turn on Inheritance 'Same as: 'SE_SELF_RELATIVE + SE_DACL_AUTO_INHERITED + SE_DACL_PRESENT CONST DENY_INHERIT = 37892 'Used in ControlFlag to turn off Inheritance 'Same as: 'SE_SELF_RELATIVE + SE_DACL_PROTECTED + SE_DACL_AUTO_INHERITED + SE_DACL_PRESENT Const SE_OWNER_DEFAULTED = 1 'A default mechanism, rather than the the original provider of the security 'descriptor, provided the security descriptor's owner security identifier (SID).
Const SE_GROUP_DEFAULTED = 2 'A default mechanism, rather than the the original provider of the security 'descriptor, provided the security descriptor's group SID.
Const SE_DACL_PRESENT = 4 'Indicates a security descriptor that has a DACL. If this flag is not set, 'or if this flag is set and the DACL is NULL, the security descriptor allows 'full access to everyone.
Const SE_DACL_DEFAULTED = 8 'Indicates a security descriptor with a default DACL. For example, if an 'object's creator does not specify a DACL, the object receives the default 'DACL from the creator's access token. This flag can affect how the system 'treats the DACL, with respect to ACE inheritance. The system ignores this 'flag if the SE_DACL_PRESENT flag is not set.
Const SE_SACL_PRESENT = 16 'Indicates a security descriptor that has a SACL.
Const SE_SACL_DEFAULTED = 32 'A default mechanism, rather than the the original provider of the security 'descriptor, provided the SACL. This flag can affect how the system treats 'the SACL, with respect to ACE inheritance. The system ignores this flag if 'the SE_SACL_PRESENT flag is not set.
Const SE_DACL_AUTO_INHERIT_REQ = 256 'Requests that the provider for the object protected by the security descriptor 'automatically propagate the DACL to existing child objects. If the provider 'supports automatic inheritance, it propagates the DACL to any existing child 'objects, and sets the SE_DACL_AUTO_INHERITED bit in the security descriptors 'of the object and its child objects.
Const SE_SACL_AUTO_INHERIT_REQ = 512 'Requests that the provider for the object protected by the security descriptor 'automatically propagate the SACL to existing child objects. If the provider 'supports automatic inheritance, it propagates the SACL to any existing child 'objects, and sets the SE_SACL_AUTO_INHERITED bit in the security descriptors of 'the object and its child objects.
Const SE_DACL_AUTO_INHERITED = 1024 'Windows 2000 only. Indicates a security descriptor in which the DACL is set up 'to support automatic propagation of inheritable ACEs to existing child objects. 'The system sets this bit when it performs the automatic inheritance algorithm 'for the object and its existing child objects. This bit is not set in security 'descriptors for Windows NT versions 4.0 and earlier, which do not support 'automatic propagation of inheritable ACEs.
Const SE_SACL_AUTO_INHERITED = 2048 'Windows 2000: Indicates a security descriptor in which the SACL is set up to 'support automatic propagation of inheritable ACEs to existing child objects. 'The system sets this bit when it performs the automatic inheritance algorithm 'for the object and its existing child objects. This bit is not set in security 'descriptors for Windows NT versions 4.0 and earlier, which do not support automatic 'propagation of inheritable ACEs.
Const SE_DACL_PROTECTED = 4096 'Windows 2000: Prevents the DACL of the security descriptor from being modified 'by inheritable ACEs.
Const SE_SACL_PROTECTED = 8192 'Windows 2000: Prevents the SACL of the security descriptor from being modified 'by inheritable ACEs.
Const SE_SELF_RELATIVE = 32768 'Indicates a security descriptor in self-relative format with all the security 'information in a contiguous block of memory. If this flag is not set, the security 'descriptor is in absolute format. For more information, see Absolute and 'Self-Relative Security Descriptors in the Platform SDK topic Low-Level Access-Control.
'********************* ACE Flags ********************* CONST OBJECT_INHERIT_ACE = 1 'Noncontainer child objects inherit the ACE as an effective ACE. For child 'objects that are containers, the ACE is inherited as an inherit-only ACE 'unless the NO_PROPAGATE_INHERIT_ACE bit flag is also set.
CONST CONTAINER_INHERIT_ACE = 2 'Child objects that are containers, such as directories, inherit the ACE 'as an effective ACE. The inherited ACE is inheritable unless the 'NO_PROPAGATE_INHERIT_ACE bit flag is also set.
CONST NO_PROPAGATE_INHERIT_ACE = 4 'If the ACE is inherited by a child object, the system clears the 'OBJECT_INHERIT_ACE and CONTAINER_INHERIT_ACE flags in the inherited ACE. 'This prevents the ACE from being inherited by subsequent generations of objects.
CONST INHERIT_ONLY_ACE = 8 'Indicates an inherit-only ACE which does not control access to the object 'to which it is attached. If this flag is not set, the ACE is an effective 'ACE which controls access to the object to which it is attached. Both 'effective and inherit-only ACEs can be inherited depending on the state of 'the other inheritance flags.
CONST INHERITED_ACE = 16 'Windows NT 5.0 and later, Indicates that the ACE was inherited. The system sets 'this bit when it propagates an inherited ACE to a child object.
CONST ACEFLAG_VALID_INHERIT_FLAGS = 31 'Indicates whether the inherit flags are valid.
'Two special flags that pertain only to ACEs that are contained in a SACL are listed below.
CONST SUCCESSFUL_ACCESS_ACE_FLAG = 64 'Used with system-audit ACEs in a SACL to generate audit messages for successful 'access attempts.
CONST FAILED_ACCESS_ACE_FLAG = 128 'Used with system-audit ACEs in a SACL to generate audit messages for failed 'access attempts.
'********************* ACE Types ********************* CONST ACCESS_ALLOWED_ACE_TYPE = 0 'Used with Win32_Ace AceTypes CONST ACCESS_DENIED_ACE_TYPE = 1 'Used with Win32_Ace AceTypes CONST AUDIT_ACE_TYPE = 2 'Used with Win32_Ace AceTypes
'********************* Access Masks *********************
Dim Perms_LStr, Perms_SStr, Perms_Const 'Permission LongNames Perms_LStr=Array("Synchronize" , _ "Take Ownership" , _ "Change Permissions" , _ "Read Permissions" , _ "Delete" , _ "Write Attributes" , _ "Read Attributes" , _ "Delete Subfolders and Files" , _ "Traverse Folder / Execute File", _ "Write Extended Attributes" , _ "Read Extended Attributes" , _ "Create Folders / Append Data" , _ "Create Files / Write Data" , _ "List Folder / Read Data" ) 'Permission Single Character codes Perms_SStr=Array("" , _ "D" , _ "C" , _ "B" , _ "A" , _ "9" , _ "8" , _ "7" , _ "6" , _ "5" , _ "4" , _ "3" , _ "2" , _ "1" ) 'Permission Integer Perms_Const=Array(1048576 , _ &H80000 , _ &H40000 , _ &H20000 , _ &H10000 , _ &H100 , _ &H80 , _ &H40 , _ &H20 , _ &H10 , _ &H8 , _ &H4 , _ &H2 , _ &H1 )
startTime = Timer
'Initializing Default values a_Used = FALSE t_Used = FALSE e_Used = FALSE g_Used = FALSE r_used = FALSE p_Used = FALSE d_used = FALSE i_used = FALSE l_Used = FALSE q_Used = FALSE RemoteServer_Used = FALSE strRemoteServerName = "" strRemoteShareName = "" RemoteUserName_Used = FALSE strRemoteUserName = "" strRemotePassword = "" debug_Used = FALSE 'Parameter Passed filename_var = "" DisplayDirPath = "" ActualDirPath = ""
debug_on = FALSE 'Actual value checked in script blnQuiet = FALSE strOutputFile = "XCACLS.Log"
BoolUsingCScript = IsEngineCScript()
'Parse the command line intOpMode = intParseCmdLine() If Err.Number Then Wscript.Echo "Error while parsing the command line." & vbcrlf & "Error " & Err.Number & ": " & Err.Description WScript.Quit End if
'Open the output file so we can use it through out the script If l_Used then Call OpenOutputFile()
Call PrintMsg("Starting Script at " & now)
'FSO is used in several funcitons, so lets set it globally. Set fso = WScript.CreateObject("Scripting.FileSystemObject") If blnErrorOccurred(" occurred in getting FileSystemObject.") Then WScript.Quit
'Put statements in loop to be able to drop out and clear variables Do If debug_on then Call PrintMsg("Main: Enter")
'Lets get to the work to be done... If Not IsOSSupported() then Exit Do
Call PrintArguments() 'Show the arguments entered
'Now lets do the work based upon the arguments entered. Select Case intOpMode Case CONST_SHOW_USAGE Call ShowUsage() Case CONST_PROCEED 'Lets get the objService object which is used throughout the script
If Not SetMainVars(filename_var) then Exit Do
Call PrintMsg("") If g_Used or r_Used or p_Used or d_Used or o_used then Call CheckTrustees() End if
If QryBaseNameHasWildcards or QryExtensionHasWildcards then If debug_on then Call PrintMsg("Wildcard characters detected in """ & InitialfilenameAbsPath & """") Select Case DoesPathNameExist(fso.GetParentFolderName(InitialfilenameAbsPath)) Case 1 'Directory Call DoTheWorkOnEverythingUnderDirectory(fso.GetParentFolderName(InitialfilenameAbsPath)) Case Else Call PrintMsg("Error: Directory """ & fso.GetParentFolderName(InitialfilenameAbsPath) & """ not found.") End select Else If debug_on then Call PrintMsg("No Wildcard characters detected for """ & filename_var & """") 'If a folder is found with the same name, then we work it as a folder and include files under it. Select Case DoesPathNameExist(InitialfilenameAbsPath) Case 1 'Directory Call DoTheWorkOnThisItem(InitialfilenameAbsPath, TRUE) If t_used or a_used then Call DoTheWorkOnEverythingUnderDirectory(InitialfilenameAbsPath) End if Case 2 'File Call DoTheWorkOnThisItem(InitialfilenameAbsPath, FALSE) Case Else Call PrintMsg("Error: File/Directory """ & InitialfilenameAbsPath & """ not found.") End select End if Case Else Call PrintMsg("") Call PrintMsg(intOpMode) End Select
Call blnErrorOccurred(" occurred while in the main routine of the script.") If debug_on then Call PrintMsg("Main: Exit")
Exit Do 'We really didn't want to loop Loop 'ClearObjects that could be set and aren't needed now Set objService = Nothing Set objLocalService = Nothing Set objLocator = Nothing Call ClearObjectArray(ObjTrustee_g_var_User) Call ClearObjectArray(ObjTrustee_r_var_User) Call ClearObjectArray(ObjTrustee_p_var_User) Call ClearObjectArray(ObjTrustee_d_var_User)
Call PrintMsg("") Call PrintMsg("")
endTime = Timer call PrintMsg("Operation Complete" & vbCrLf & "Elapsed Time: " & (endTime - startTime) & " seconds.")
Call PrintMsg("") Call PrintMsg("Ending Script at " & now) Call PrintMsg("") Call PrintMsg("")
If l_Used then If strOutputFile <> "" Then objOutputFile.Close End if End if
'******************************************************************** '* End of Main Script '********************************************************************
'******************************************************************** '* '* Sub DoTheWorkOnEverythingUnderDirectory() '* Purpose: Work on Directory path passed to it, and pass paths to DoTheWorkOnThisItem sub '* Input: ThisPath - Path to directory '* Output: None '* Notes: This sub will process every file and folder under the directory passed to it. '* '********************************************************************
Sub DoTheWorkOnEverythingUnderDirectory(ThisPath)
ON ERROR RESUME NEXT
If debug_on then Call PrintMsg("DoTheWorkOnEverythingUnderDirectory: Enter")
Dim objFileSystemSet, objPath, objFileSystemSet2, objPath2, strQuery, strTempPath, booltempItsAFolder Dim f, f1, fc
Do If debug_on then Call PrintMsg("DoTheWorkOnEverythingUnderDirectory: Directory passed: """ & ThisPath & """")
'We already checked for existance so we will assume it exists.
If RemoteServer_Used then strQuery = "Select * from Cim_LogicalFile Where Name='" & Replace(ThisPath,"\","\\") & "'" Set objFileSystemSet = objService.ExecQuery(strQuery,,0) If blnErrorOccurred(" occurred setting objFileSystemSet = objService.ExecQuery(" & strQuery & ",,0).") Then Exit Do
strTempPath = "" for each objPath in objFileSystemSet If objPath.Drive <> "" then strTempPath = objPath.Path & objPath.FileName & "\" strTempPath = Replace(strTempPath, "\\", "\") Exit For End if next
strQuery = "Select * from Cim_LogicalFile Where Path='" & Replace(strTempPath,"\","\\") & "'" Set objFileSystemSet2 = objService.ExecQuery(strQuery,,0) If blnErrorOccurred(" occurred setting objFileSystemSet2 = objService.ExecQuery(" & strQuery & ",,0).") Then Exit Do
for each objPath2 in objFileSystemSet2 strTempPath = "" booltempItsAFolder = False If objPath2.Drive <> "" then If UCASE(objPath2.FileType) = "FILE FOLDER" then booltempItsAFolder = True strTempPath = objPath2.Name If QryBaseNameHasWildcards Or QryExtensionHasWildcards then If DoesItMatch(strTempPath) then Call DoTheWorkOnThisItem(strTempPath, booltempItsAFolder) End if If booltempItsAFolder then If t_used then Call DoTheWorkOnEverythingUnderDirectory(strTempPath) End if Else If booltempItsAFolder then If t_used then Call DoTheWorkOnThisItem(strTempPath, booltempItsAFolder) Call DoTheWorkOnEverythingUnderDirectory(strTempPath) End if Else If a_used then Call DoTheWorkOnThisItem(strTempPath, booltempItsAFolder) End if End if End if End if next Else Set f = fso.GetFolder(ThisPath)
If blnErrorOccurred(" occurred in getting FileSystemObject.GetFolder") Then Exit Do Set fc = f.Files For Each f1 in fc If QryBaseNameHasWildcards Or QryExtensionHasWildcards then If DoesItMatch(f1.Path) then Call DoTheWorkOnThisItem(f1.Path, False) End if Else If a_used then Call DoTheWorkOnThisItem(f1.Path, False) End if Next Set fc = Nothing
Set fc = f.SubFolders
For Each f1 in fc If QryBaseNameHasWildcards Or QryExtensionHasWildcards then If DoesItMatch(f1.Path) then Call DoTheWorkOnThisItem(f1.Path, True) End if If t_used then Call DoTheWorkOnEverythingUnderDirectory(f1.Path) Else If t_used then Call DoTheWorkOnThisItem(f1.Path, True) Call DoTheWorkOnEverythingUnderDirectory(f1.Path) End if End if Next Set fc = Nothing End if
Exit Do 'We really didn't want to loop Loop 'ClearObjects that could be set and aren't needed now Set f = Nothing Set fc = Nothing Set f1 = Nothing Set objPath = Nothing Set objFileSystemSet = Nothing Set objPath2 = Nothing Set objFileSystemSet2 = Nothing
Call blnErrorOccurred(" occurred while in the DoTheWorkOnEverythingUnderDirectory routine.") If debug_on then Call PrintMsg("DoTheWorkOnEverythingUnderDirectory: Exit") End Sub
'******************************************************************** '* '* Sub DoTheWorkOnThisItem() '* Purpose: Work on File/Folder passed to it, and pass to Work routine '* Input: ABSPath - Path to File/Folder '* Output: TRUE if Successful, FALSE if not '* '********************************************************************
Sub DoTheWorkOnThisItem(AbsPath, IsItAFolder)
ON ERROR RESUME NEXT
If debug_on then Call PrintMsg("DoTheWorkOnThisItem: Enter")
Dim DisplayIt
Do DisplayIt = TRUE
Call PrintMsg("") Call PrintMsg("**************************************************************************") If IsItAFolder then Call PrintMsg("Directory: " & DisplayPathString(AbsPath)) Else Call PrintMsg("File: " & DisplayPathString(AbsPath)) End if 'We already checked for existance so we will assume it exists. If g_Used or r_Used or p_Used or d_Used or o_used or i_used then Call SetACLForObject(AbsPath, IsItAFolder) DisplayIt = FALSE End If If DisplayIt then Call DisplayThisACL(AbsPath) End if Call PrintMsg("**************************************************************************") Exit Do Loop
Call blnErrorOccurred(" occurred while in the DoTheWorkOnThisItem routine.") If debug_on then Call PrintMsg("DoTheWorkOnThisItem: Exit")
End Sub
'******************************************************************** '* '* Sub DisplayThisACL() '* Purpose: Shows ACL's that are applied to strPath '* Input: strPath - string containing path of file or folder, ShowLong - If TRUE, permissions are in long form '* Output: prints the acls '* '********************************************************************
Sub DisplayThisACL(strPath)
ON ERROR RESUME NEXT
If debug_on then Call PrintMsg("DisplayThisACL: Enter")
Dim objFileSecSetting, objOutParams, objSecDescriptor, objOwner, objDACL_Member Dim objtrustee, numAceFlags, strAceFlags, x, strAceType, numControlFlags, ReturnAceFlags, TempSECString ReDim arraystrACLS(0)
'Put statements in loop to be able to drop out and clear variables Do set objFileSecSetting = objService.Get("Win32_LogicalFileSecuritySetting.Path='" & strPath & "'") If blnErrorOccurred(" occurred setting Win32_LogicalFileSecuritySetting object.") Then Exit Do
Set objOutParams = objFileSecSetting.ExecMethod_("GetSecurityDescriptor") If blnErrorOccurred(" occurred when this command was issued: GetSecurityDescriptor.") Then Exit Do
set objSecDescriptor = objOutParams.Descriptor If blnErrorOccurred(" occurred setting objSecDescriptor = objOutParams.Descriptor.") Then Exit Do
numControlFlags = objSecDescriptor.ControlFlags
If IsArray(objSecDescriptor.DACL) then Call PrintMsg("") Call PrintMsg("Permissions:") Call PrintMsg( strPackString("Type", 9, 1, TRUE) & strPackString("Username", 24, 1, TRUE) & strPackString("Permissions", 22, 1, TRUE) & strPackString("Inheritance", 22, 1, TRUE)) For Each objDACL_Member in objSecDescriptor.DACL TempSECString = "" ReturnAceFlags = 0 Select Case objDACL_Member.AceType Case ACCESS_ALLOWED_ACE_TYPE strAceType = "Allowed" Case ACCESS_DENIED_ACE_TYPE strAceType = "Denied" Case else strAceType = "Unknown" End select Set objtrustee = objDACL_Member.Trustee numAceFlags = objDACL_Member.AceFlags strAceFlags = StringAceFlag(numAceFlags, numControlFlags, SE_DACL_AUTO_INHERITED, FALSE, ReturnAceFlags) TempSECString = SECString(objDACL_Member.AccessMask,TRUE) If ReturnAceFlags = 2 then If TempSECString = "Read and Execute" then TempSECString = "List Folder Contents" End if End if Call AddStringToArray(arraystrACLS, strPackString(strAceType, 9, 1, TRUE) & strPackString(objtrustee.Domain & "\" & objtrustee.Name, 24, 1, TRUE) & strPackString(TempSECString, 22, 1, TRUE) & strPackString(strAceFlags, 22, 1, TRUE),-1) Set objtrustee = Nothing Next For x = LBound(arraystrACLS) to UBound(arraystrACLS) Call PrintMsg(arraystrACLS(x)) Next Else Call PrintMsg("") Call PrintMsg("No Permissions set") End if ReDim arraystrACLS(0) If IsArray(objSecDescriptor.SACL) then Call PrintMsg("") Call PrintMsg("Auditing:") Call PrintMsg(strPackString("Type", 9, 1, TRUE) & strPackString("Username", 24, 1, TRUE) & strPackString("Access", 22, 1, TRUE) & strPackString("Inheritance", 22, 1, TRUE)) For Each objDACL_Member in objSecDescriptor.SACL TempSECString = "" ReturnAceFlags = 0 Set objtrustee = objDACL_Member.Trustee numAceFlags = objDACL_Member.AceFlags strAceType = StringSACLAceFlag(numAceFlags) strAceFlags = StringAceFlag(numAceFlags, numControlFlags, SE_SACL_AUTO_INHERITED, FALSE, ReturnAceFlags) TempSECString = SECString(objDACL_Member.AccessMask,TRUE) If ReturnAceFlags = 2 then If TempSECString = "Read and Execute" then TempSECString = "List Folder Contents" End if End if Call AddStringToArray(arraystrACLS, strPackString(strAceType, 9, 1, TRUE) & strPackString(objtrustee.Domain & "\" & objtrustee.Name, 24, 1, TRUE) & strPackString(TempSECString, 22, 1, TRUE) & strPackString(strAceFlags, 22, 1, TRUE),-1) Set objtrustee = Nothing Next For x = LBound(arraystrACLS) to UBound(arraystrACLS) Call PrintMsg(arraystrACLS(x)) Next Else Call PrintMsg("") Call PrintMsg("No Auditing set") End if
Set objOwner = objSecDescriptor.Owner If blnErrorOccurred(" occurred setting objOwner = objSecDescriptor.Owner.") Then Exit Do Call PrintMsg("") Call PrintMsg("Owner: " & objOwner.Domain & "\" & objOwner.Name)
Exit Do 'We really didn't want to loop Loop 'ClearObjects that could be set and aren't needed now Set objOwner = Nothing Set objSecDescriptor = Nothing Set objDACL_Member = Nothing Set objtrustee = Nothing Set objOutParams = Nothing Set objFileSecSetting = Nothing
Call blnErrorOccurred(" occurred while in the DisplayThisACL routine.") If debug_on then Call PrintMsg("DisplayThisACL: Exit")
End Sub
'******************************************************************** '* '* Sub SetACLForObject() '* Purpose: Set the ACL for the file/folder passed '* Input: strPath - string containing path of file or folder, IsItAFolder, '* Output: None '* '********************************************************************
Sub SetACLForObject(strPath, IsItAFolder) ON ERROR RESUME NEXT
If debug_on then Call PrintMsg("SetACLForObject: Enter")
Dim objFileSecSetting, objmethod, objSecDescriptor Dim objtrustee, objInParam, objOutParams, objOwner Dim objParentFileSecSetting, objParentOutParams, objParentSecDescriptor
Dim OldAceObj, ObjNewAce, NewobjDescriptor, RetVal, i_Var_Copy_Temp Dim BlankDaclObj, OldDaclObj(), NewDaclObj(), ImpDenyDaclObj() Dim ImpAllowDaclObj(), ImpDenyObjectDaclObj()
Dim objTempTrustee, i, t, ThisUserAccess, RightsToGive, NewRights Dim intTempAccessMask, boolDoTheUpdate Dim strOldAccount, strThisAccount, NewArraySize, NewArrayMember, BoolDoThisOne Dim ControlFlagsVar, BoolAllowInherited, BoolGetInherited, BoolInitialInheritRightsPresent, numControlFlags, ReturnAceFlags
'Put statements in loop to be able to drop out and clear variables Do
'Initialize all of the new ACL objects ReDim OldDaclObj(0) ReDim NewDaclObj(0) ReDim ImpDenyDaclObj(0) ReDim ImpAllowDaclObj(0) ReDim InheritedObjectDaclObj(0) ReDim BlankDaclObj(0) BoolAllowInherited = FALSE BoolGetInherited = FALSE BoolInitialInheritRightsPresent = FALSE
If debug_on then Call PrintMsg("SetACLForObject: Working on """ & strPath & """")
set objFileSecSetting = objService.Get("Win32_LogicalFileSecuritySetting.Path='" & strPath & "'") If blnErrorOccurred(" occurred setting Win32_LogicalFileSecuritySetting object.") Then Exit Do
Set objOutParams = objFileSecSetting.ExecMethod_("GetSecurityDescriptor") If blnErrorOccurred(" occurred Setting objOutParams = objFileSecSetting.ExecMethod_(""GetSecurityDescriptor"")") Then Exit Do
set objSecDescriptor = objOutParams.Descriptor If blnErrorOccurred(" occurred setting objSecDescriptor = objOutParams.Descriptor.") Then Exit Do
Set objOwner = objSecDescriptor.Owner If blnErrorOccurred(" occurred setting objOwner = objSecDescriptor.Owner.") Then Exit Do
numControlFlags = objSecDescriptor.ControlFlags
If debug_on then Call PrintMsg("SetACLForObject: Getting DACL array")
If e_Used then 'If e_Used then the old ACL list is maintained, if not we start fresh. Call GetDaclArray(OldDaclObj,objSecDescriptor, FALSE) If blnErrorOccurred(" occurred after Calling GetDaclArray(OldDaclObj,objSecDescriptor, FALSE)") Then Exit Do End if
If UBound(OldDaclObj) = 0 then 'If the array is empty and we need to Copy or Enable Inheritance, we need to set Inheritance and get array again. If i_used then 'i_var 3 = "REMOVE", if you are not removing Inheritance, you must have the Inherited DACL's If i_var < 3 then BoolGetInherited = TRUE End if Else 'If Copy or Enable Inheritance is set and there was no Inherited Properties, we need to set Inheritance and get array again. If i_used then 'i_var 3 = "REMOVE", if you are not removing Inheritance, you must have the Inherited DACL's If i_var < 3 then BoolGetInherited = TRUE For i = 1 to UBound(OldDaclObj) If blnErrorOccurred(" occurred looping through OldDaclObj.") Then Exit Do Set OldAceObj = OldDaclObj(i) If StringAceFlag(OldAceObj.AceFlags, numControlFlags, SE_DACL_AUTO_INHERITED, TRUE, ReturnAceFlags) = "Inherited" then BoolInitialInheritRightsPresent = TRUE BoolGetInherited = FALSE Exit For End if Next End if End if If BoolGetInherited Then 'We need the inherited ACE's so lets get them.
If debug_on then Call PrintMsg("SetACLForObject: Inherited ACL's not found and needed, getting from Parent Directory")
'Any existing ACE's will remain in array Set NewobjDescriptor = objService.Get("Win32_SecurityDescriptor").Spawninstance_ If blnErrorOccurred(" occurred Setting NewobjDescriptor = objService.Get(""Win32_SecurityDescriptor"").Spawninstance_") Then Exit Do
NewobjDescriptor.ControlFlags = ALLOW_INHERIT If blnErrorOccurred(" occurred setting objSecDescriptor.ControlFlags = ALLOW_INHERIT") Then Exit Do
Set objmethod = objFileSecSetting.Methods_("SetSecurityDescriptor") If blnErrorOccurred(" occurred setting objmethod = objFileSecSetting.Methods_(""SetSecurityDescriptor"")") Then Exit Do
Set objInParam = objmethod.inParameters.SpawnInstance_() If blnErrorOccurred(" occurred Setting objInParam = objmethod.inParameters.SpawnInstance_()") Then Exit Do
objInParam.Properties_.item("Descriptor") = NewobjDescriptor If blnErrorOccurred(" occurred setting objInParam.Properties_.item(""Descriptor"") = NewobjDescriptor") Then Exit Do
Set RetVal = objFileSecSetting.ExecMethod_("SetSecurityDescriptor", objInParam) If blnErrorOccurred(" occurred setting RetVal = objFileSecSetting.ExecMethod_(""SetSecurityDescriptor"", objInParam)") Then Exit Do
'Now we need to get only the Inherited ACE's (Everyone group may be set if DACL array was empty) Set objOutParams = objFileSecSetting.ExecMethod_("GetSecurityDescriptor") If blnErrorOccurred(" occurred Setting objOutParams = objFileSecSetting.ExecMethod_(""GetSecurityDescriptor"")") Then Exit Do
set objSecDescriptor = objOutParams.Descriptor If blnErrorOccurred(" occurred setting objSecDescriptor = objOutParams.Descriptor.") Then Exit Do
Call GetDaclArray(OldDaclObj,objSecDescriptor, TRUE) If blnErrorOccurred(" occurred when Calling GetDaclArray(OldDaclObj,objSecDescriptor, TRUE)") Then Exit Do Set NewobjDescriptor = Nothing Set objmethod = Nothing Set objInParam = Nothing Set RetVal = Nothing boolDoTheUpdate = TRUE End if 'Now we have the inherited rights, if one of the revoked users is in the list, then we need to copy the list and turn off inheritance. If debug_on then Call PrintMsg("SetACLForObject: Looking for Revoke users in Inherited list, if found, Inherited list will be copied to Effective list and inheritance turned off, so we can revoke user") i_Var_Copy_Temp = FALSE If r_Used then 'Revoke user if present in Inherited Allowed or Denied lists If UBound(OldDaclObj) > 0 then For i = 1 to UBound(OldDaclObj) If blnErrorOccurred(" occurred looping through OldDaclObj.") Then Exit Do Set OldAceObj = OldDaclObj(i) If StringAceFlag(OldAceObj.AceFlags, numControlFlags, SE_DACL_AUTO_INHERITED, TRUE, ReturnAceFlags) = "Inherited" then For t = LBound(r_var_User) to UBound(r_var_User) If r_Var_User(t) <> "" then &
_________________________
!download KiXnet
|
Top
|
|
|
|
Moderator: Glenn Barnas, NTDOC, Arend_, Jochen, Radimus, Allen, ShaneEP, Ruud van Velsen, Mart
|
0 registered
and 558 anonymous users online.
|
|
|