#87221 - 2002-08-07 11:42 PM
XCACLS VB script v2.7 replacement for the executeable
|
NTDOC
Administrator
Registered: 2000-07-28
Posts: 11624
Loc: CA
|
FYI,
CACLS and XCACLS are Resource Kit utils that were written for NT 4.0
It was discovered that they did not function properly on Windows 2000 but since they were not supported tools Microsoft did not feel the need to fix them.
Then they tried a fix in SP2 to fix CACLS, but there are internal papers at Microsoft that indicate the fix for CACLS.EXE was not always successful.
As for XCACLS, they simply chose to not even attempt a fix.
Microsoft Knowledge Base Article - Q268546
Cacls.exe Orders ACEs Incorrectly When Granting Rights
http://support.microsoft.com/default.aspx?scid=kb;[LN];Q268546
Here is a Visual Basic script written internally at Microsoft that produces the same functionality as the XCACLS.EXE file did, but without the associated problems.
As far as I know, this script is also NOT supported by Microsoft (just as the Resource Kit files are not supported).
The author expressed no objections to me publicly posting it as long as I did not include his email address and let others know that it is not supported by Microsoft.
With that said... here is the latest version which requires WSH v5.6
This script is version 2.7 and is just under 4,000 lines of code (including a lot of highly commented code)
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
If TrusteesMatch(ObjTrustee_r_var_User(t), OldAceObj.Trustee) then
'We found a match
i_Var_Copy_Temp = TRUE
Call PrintMsg(" - One of the Revoked Users is listed under Inherited permissions.")
Call PrintMsg(" Copying Inherited Permissions and turning off inheritance.")
Exit For
End if
End if
Next
End if
Next
End If
End If
If debug_on then Call PrintMsg("SetACLForObject: Sorting DACL array and modifying rights if needed")
If UBound(OldDaclObj) > 0 then
For i = 1 to UBound(OldDaclObj)
BoolDoThisOne = TRUE
If blnErrorOccurred(" occurred looping through OldDaclObj.") Then Exit Do
Set OldAceObj = OldDaclObj(i)
Set objTempTrustee = OldAceObj.Trustee
intTempAccessMask = OldAceObj.AccessMask
If debug_on then Call PrintMsg("SetACLForObject: """ & TrusteesDisplay(objTempTrustee) & """ current rights = " & SECString(OldAceObj.AccessMask,TRUE))
If StringAceFlag(OldAceObj.AceFlags, numControlFlags, SE_DACL_AUTO_INHERITED, TRUE, ReturnAceFlags) = "Inherited" then
If i_Var_Copy_Temp then 'This makes sure that inherited users that are revoked can be revoked...
OldAceObj.AceFlags = OBJECT_INHERIT_ACE + CONTAINER_INHERIT_ACE
Else
BoolDoThisOne = FALSE
If i_used then 'We should make them effective ACL's
Select Case i_var
Case 1 'Inherit
Call AddObjectToArray(InheritedObjectDaclObj, OldAceObj, -1)
Case 2 'Copy to Effective
OldAceObj.AceFlags = OBJECT_INHERIT_ACE + CONTAINER_INHERIT_ACE
BoolDoThisOne = TRUE
End Select
Else
Call AddObjectToArray(InheritedObjectDaclObj, OldAceObj, -1)
End If
End if
End if
If p_Used then 'Replace user rights if present
For t = LBound(p_var_User) to UBound(p_var_User)
If p_Var_User(t) <> "" then
If TrusteesMatch(ObjTrustee_p_var_User(t), objTempTrustee) then
'We found a match so skip it.
BoolDoThisOne = FALSE
Call PrintMsg("Replacing rights for existing user """ & p_Var_User(t) & """")
End if
End if
Next
Else
End If
If r_Used then 'Revoke user if present in Allowed or Denied lists
For t = LBound(r_var_User) to UBound(r_var_User)
If r_Var_User(t) <> "" then
If TrusteesMatch(ObjTrustee_r_var_User(t), objTempTrustee) then
'We found a match so skip it.
BoolDoThisOne = FALSE
Call PrintMsg("Revoking rights for existing user """ & r_Var_User(t) & """")
End if
End if
Next
End if
If BoolDoThisOne then
Select Case OldAceObj.AceType
Case ACCESS_ALLOWED_ACE_TYPE
Call AddObjectToArray(ImpAllowDaclObj, OldAceObj, -1)
Case ACCESS_DENIED_ACE_TYPE
Call AddObjectToArray(ImpDenyDaclObj, OldAceObj, -1)
Case Else
Call PrintMsg("Error: Bad ace...." & Hex(OldAceObj.AceType))
End Select
End if
Next
End If
'Add ACE's that need to be added:
If g_Used then 'Grant rights for these users
If debug_on then Call PrintMsg("SetACLForObject: Granting Rights for Users (that haven't been granted already)")
Call AccessMask_New(ImpAllowDaclObj, ObjTrustee_g_var_User, g_var_User, g_var_Perm, ACCESS_ALLOWED_ACE_TYPE, INHERIT_ONLY_ACE + OBJECT_INHERIT_ACE, "Granting")
If blnErrorOccurred(" occurred when Building Granted (File) Rights array") Then Exit Do
If IsItAFolder then
Call AccessMask_New(ImpAllowDaclObj, ObjTrustee_g_var_User, g_var_User, g_var_Spec, ACCESS_ALLOWED_ACE_TYPE, CONTAINER_INHERIT_ACE, "Granting")
If blnErrorOccurred(" occurred when Building Granted (Folder) Rights array") Then Exit Do
End if
End if
If p_Used then 'Grant rights for these users (Replace rights)
If debug_on then Call PrintMsg("SetACLForObject: Replacing Rights for Users (that haven't been granted already)")
Call AccessMask_New(ImpAllowDaclObj, ObjTrustee_p_var_User, p_var_User, p_var_Perm, ACCESS_ALLOWED_ACE_TYPE, INHERIT_ONLY_ACE + OBJECT_INHERIT_ACE , "Replacing")
If blnErrorOccurred(" occurred when Building Replace (File) Rights array") Then Exit Do
If IsItAFolder then
Call AccessMask_New(ImpAllowDaclObj, ObjTrustee_p_var_User, p_var_User, p_var_Spec, ACCESS_ALLOWED_ACE_TYPE, CONTAINER_INHERIT_ACE, "Replacing")
If blnErrorOccurred(" occurred when Building Replace (Folder) Rights array") Then Exit Do
End if
End if
If d_Used then 'Deny rights for these users
If debug_on then Call PrintMsg("SetACLForObject: Denying Rights for Users (that haven't been denied already)")
Call AccessMask_New(ImpDenyDaclObj, ObjTrustee_d_var_User, d_var_User, d_var_Perm, ACCESS_DENIED_ACE_TYPE, INHERIT_ONLY_ACE + OBJECT_INHERIT_ACE , "Denying")
If blnErrorOccurred(" occurred when Building Denied (File) Rights array") Then Exit Do
If IsItAFolder then
Call AccessMask_New(ImpDenyDaclObj, ObjTrustee_d_var_User, d_var_User, d_var_Spec, ACCESS_DENIED_ACE_TYPE, CONTAINER_INHERIT_ACE, "Denying")
If blnErrorOccurred(" occurred when Building Denied (Folder) Rights array") Then Exit Do
End if
End if
' Combine the ACEs in the proper order
' Implicit Deny
' Implicit Allow
' Inherited Aces
If debug_on then Call PrintMsg("SetACLForObject: Forming new DACL array")
boolDoTheUpdate = FALSE
ReDim NewDaclObj(0)
If UBound(ImpDenyDaclObj) > 0 then '0 member is always blank
For i = (LBound(ImpDenyDaclObj) + 1) to UBound(ImpDenyDaclObj)
boolDoTheUpdate = TRUE
Call AddObjectToArray(NewDaclObj, ImpDenyDaclObj(i), 0)
Next
If blnErrorOccurred(" occurred when Building Implicit Deny array") Then Exit Do
End if
If UBound(ImpAllowDaclObj) > 0 then
For i = (LBound(ImpAllowDaclObj) + 1) to UBound(ImpAllowDaclObj)
boolDoTheUpdate = TRUE
Call AddObjectToArray(NewDaclObj, ImpAllowDaclObj(i), 0)
Next
If blnErrorOccurred(" occurred when Building Implicit Allow array") Then Exit Do
End if
If UBound(InheritedObjectDaclObj) > 0 then
BoolAllowInherited = TRUE
For i = (LBound(InheritedObjectDaclObj) + 1) to UBound(InheritedObjectDaclObj)
boolDoTheUpdate = TRUE
InheritedObjectDaclObj(i).AccessMask = 0
Call AddObjectToArray(NewDaclObj, InheritedObjectDaclObj(i), 0)
Next
If blnErrorOccurred(" occurred when Building Inherited Object array") Then Exit Do
End if
If Not boolDoTheUpdate Then
Set NewDaclObj(0) = CreateObject("AccessControlEntry")
If blnErrorOccurred(" occurred Setting NewDaclObj(0) = CreateObject(""AccessControlEntry"").") Then Exit Do
End if
If i_Var_Copy_Temp then
If debug_on then Call PrintMsg("SetACLForObject: Inheritance turned off because one of the inherited users is revoked on this object.")
ControlFlagsVar = SE_DACL_PRESENT
Else
If i_used then
Select Case i_var
Case 1
ControlFlagsVar = ALLOW_INHERIT
Case 3
ControlFlagsVar = DENY_INHERIT
case Else '2 and non matching
ControlFlagsVar = SE_DACL_PRESENT
End Select
Else
If BoolAllowInherited or BoolInitialInheritRightsPresent then
ControlFlagsVar = ALLOW_INHERIT
Else
ControlFlagsVar = DENY_INHERIT
End if
End if
End if
If debug_on then Call PrintMsg("SetACLForObject: Saving new Descriptor")
Set NewobjDescriptor = objService.Get("Win32_SecurityDescriptor").Spawninstance_
If blnErrorOccurred(" occurred Setting NewobjDescriptor = objService.Get(""Win32_SecurityDescriptor"").Spawninstance_") Then Exit Do
If boolDoTheUpdate then
NewobjDescriptor.Properties_.item("DACL") = NewDaclObj
If blnErrorOccurred(" occurred setting NewobjDescriptor.Properties_.item(""DACL"") = NewDaclObj") Then Exit Do
Else 'Making DACL Blank
Set BlankDaclObj(0) = objService.Get("Win32_Ace").Spawninstance_
If blnErrorOccurred(" occurred Setting BlankDaclObj(0) = objService.Get(""Win32_Ace"").Spawninstance_") Then Exit Do
NewobjDescriptor.Properties_.item("DACL") = BlankDaclObj
If blnErrorOccurred(" occurred setting NewobjDescriptor.Properties_.item(""DACL"") = BlankDaclObj") Then Exit Do
End if
If o_Used then 'Change Ownership
If debug_on then Call PrintMsg("SetACLForObject: Changing Ownership")
If o_Var <> "" then
Set objTempTrustee = Nothing
Set objTempTrustee = SetTrustee(o_var)
If Not objTempTrustee Is Nothing then
If TrusteesMatch(objOwner, objTempTrustee) then
Call PrintMsg("Ownership not changed, owner is already set to """ & TrusteesDisplay(objTempTrustee) & """")
Else
NewobjDescriptor.Properties_.item("Owner") = objTempTrustee
If blnErrorOccurred(" occurred setting NewobjDescriptor.Properties_.item(""Owner"") = objTempTrustee") Then Exit Do
Call PrintMsg("Changed Ownership to """ & TrusteesDisplay(objTempTrustee) & """")
End if
Else
Call PrintMsg("Failed to Change Ownership to user """ & o_var & """")
End if
End if
End if
NewobjDescriptor.ControlFlags = ControlFlagsVar
If blnErrorOccurred(" occurred setting NewobjDescriptor.ControlFlags = ControlFlagsVar") 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
Call PrintMsg("Completed successfully.")
Exit Do 'We really didn't want to loop
Loop
'ClearObjects that could be set and aren't needed now
Set objOwner = Nothing
Set objFileSecSetting = Nothing
Set objmethod = Nothing
Set objSecDescriptor = Nothing
Set objtrustee = Nothing
Set objInParam = Nothing
Set objOutParams = Nothing
Set OldAceObj = Nothing
Set ObjNewAce = Nothing
Set NewobjDescriptor = Nothing
Set objTempTrustee = Nothing
Set RetVal = Nothing
Call blnErrorOccurred(" occurred while in the SetACLForObject routine.")
If debug_on then Call PrintMsg("SetACLForObject: Exit")
End Sub
'********************************************************************
'*
'* Function AccessMask_New()
'* Purpose: Takes a list of users with permissions and adds them to the list
'* Input: Array_ACLobj : DACL Array
'* Array_Users : Array of users
'* Array_Perm : Array of permissions
'* AceType : Type of Permissions (Allow or Deny)
'* AceFlag : Apply to what (Files or Folders)
'* strAction : String saying what the action was (Grant, Replace, or Deny)
'* Output: Acl Array Object
'*
'********************************************************************
Function AccessMask_New(byref Array_ACLobj, byref Array_ObjTrustee, Array_Users, Array_Perm, AceType, AceFlag, strAction)
ON ERROR RESUME NEXT
If debug_on then Call PrintMsg("AccessMask_New: Enter")
Dim t, objNEWACE, RightsToGive, AceTypeString
'Put statements in loop to be able to drop out and clear variables
Do
AccessMask_New = FALSE
If AceFlag = CONTAINER_INHERIT_ACE then
AceTypeString = """This Folder and Subfolders"""
Else
AceTypeString = """Files Only"""
End if
For t = LBound(Array_Users) to UBound(Array_Users)
If blnErrorOccurred(" occurred while " & strAction & " permissions.") Then Exit Do
If Array_Users(t) <> "" and Array_Perm(t) <> "" then
If IsObject(Array_ObjTrustee(t)) then
RightsToGive = SECBitMask(Array_Perm(t))
If blnErrorOccurred(" occurred getting rights for " & Array_Users(t) & ".") Then Exit Do
Set objNEWACE = SetACE(RightsToGive, AceFlag, AceType, Array_ObjTrustee(t))
If blnErrorOccurred(" occurred creating ""ACE Object"" for " & Array_Users(t) & ".") Then Exit Do
Call AddObjectToArray(Array_ACLobj, objNEWACE, -1)
If blnErrorOccurred(" occurred adding (" & strAction & ") New ACE object to array.") Then Exit Do
Set objNEWACE = Nothing
Call PrintMsg(strAction & " NTFS rights (" & SECString(RightsToGive,TRUE) & " access for " & AceTypeString & ") for """ & Array_Users(t) & """")
Else
Call PrintMsg("Failed " & strAction & " NTFS rights (" & AceTypeString & ") for """ & Array_Users(t) & """")
End if
End if
Next
AccessMask_New = TRUE
Exit Do 'We really didn't want to loop
Loop
Set objNEWACE = Nothing
If debug_on then Call PrintMsg("AccessMask_New: Return = " & AccessMask_New)
Call blnErrorOccurred(" occurred while in the AccessMask_New routine.")
If debug_on then Call PrintMsg("AccessMask_New: Exit")
End Function
'********************************************************************
'*
'* Sub TrusteesMatch()
'* Purpose: Checks the Trustee to the Name and Domain and returns boolean TRUE if they match
'* Input: objTrusteeA, objTrusteeB
'* Output: Boolean
'* Notes: This is a nice way to check if one trustee matches another, the procedure can change
'* and compare different values and only needs to be changed here, not in the rest of the code.
'*
'********************************************************************
Function TrusteesMatch(ByRef objTrusteeA, ByRef objTrusteeB)
ON ERROR RESUME NEXT
If debug_on then Call PrintMsg("TrusteesMatch: Enter")
'Put statements in loop to be able to drop out and clear variables
Do
TrusteesMatch = FALSE
If debug_on then Call PrintMsg("TrusteesMatch: Checking Users to see if they match")
If NOT IsObject(objTrusteeA) then
Exit Do
End if
If NOT IsObject(objTrusteeB) then
Exit Do
End if
If objTrusteeA.SIDString = objTrusteeB.SIDString then
TrusteesMatch = TRUE
End if
Exit Do 'We really didn't want to loop
Loop
Call blnErrorOccurred(" occurred while in the TrusteesMatch routine.")
If debug_on then Call PrintMsg("TrusteesMatch: Exit")
End Function
'********************************************************************
'*
'* Sub TrusteesDisplay()
'* Purpose: Returns a Display ready string of trustee passed in
'* Input: objTrustee
'* Output: String
'* Notes: This makes the display of a trustee a standard throughout the code
'*
'********************************************************************
Function TrusteesDisplay(ByRef objTrustee)
ON ERROR RESUME NEXT
If debug_on then Call PrintMsg("TrusteesDisplay: Enter")
'Put statements in loop to be able to drop out and clear variables
Do
TrusteesDisplay = ""
If NOT IsObject(objTrustee) then
Exit Do
End if
If objTrustee.Domain = "" then
TrusteesDisplay = objTrustee.Name
Else
TrusteesDisplay = objTrustee.Domain & "\" & objTrustee.Name
End if
Exit Do 'We really didn't want to loop
Loop
Call blnErrorOccurred(" occurred while in the TrusteesDisplay routine.")
If debug_on then Call PrintMsg("TrusteesDisplay: Exit")
End Function
'********************************************************************
'*
'* Sub CheckTrustees()
'* Purpose: Checks the list of entered users and makes them valid, run only once
'* Input: Global Variables only
'* Output: None
'* Notes: This function is called only one time in the code to get a trustee object for
'* every user entered, and if we can't find one then the user is deleted from the list.
'*
'********************************************************************
Sub CheckTrustees()
ON ERROR RESUME NEXT
If debug_on then Call PrintMsg("CheckTrustees: Enter")
'Put statements in loop to be able to drop out and clear variables
Do
If debug_on then Call PrintMsg("CheckTrustees: Checking Users to make sure they are proper Trustee's")
Call GetDefaultNames()
Call GetDefaultDomainSid()
If g_Used then 'Add to users
If debug_on then Call PrintMsg("CheckTrustees: Checking /G users")
If FixListOfTrustees(g_Var_User, ObjTrustee_g_var_User, "/G") = FALSE then exit Do
End if
If p_Used then 'Replace users
If debug_on then Call PrintMsg("CheckTrustees: Checking /P users")
If FixListOfTrustees(p_Var_User, ObjTrustee_p_var_User, "/P") = FALSE then exit Do
End if
If d_Used then 'Change users
If debug_on then Call PrintMsg("CheckTrustees: Checking /D users")
If FixListOfTrustees(d_Var_User, ObjTrustee_d_var_User, "/D") = FALSE then exit Do
End if
If r_Used then 'Revoke users
If debug_on then Call PrintMsg("CheckTrustees: Checking /R users")
If FixListOfTrustees(r_Var_User, ObjTrustee_r_var_User, "/R") = FALSE then exit Do
End if
Exit Do 'We really didn't want to loop
Loop
Call blnErrorOccurred(" occurred while in the CheckTrustees routine.")
If debug_on then Call PrintMsg("CheckTrustees: Exit")
End Sub
'********************************************************************
'*
'* Function FixListOfTrustees()
'* Purpose: Takes a list of users and changes to a valid trustee if found, else sets string to ""
'* Input: Array_Users, strAction
'* Output: Dacl Array Object
'*
'********************************************************************
Function FixListOfTrustees(byref Array_Users, byref Array_ObjTrustee, strAction)
ON ERROR RESUME NEXT
If debug_on then Call PrintMsg("FixListOfTrustees: Enter")
Dim t, objTempTrustee, strTempName
'Put statements in loop to be able to drop out and clear variables
Do
FixListOfTrustees = FALSE
For t = LBound(Array_Users) to UBound(Array_Users)
strTempName = ""
If Array_Users(t) <> "" then
'First, lets remove any special quotes in the string
'Quotation mark (") 34
Array_Users(t) = Replace(Array_Users(t),chr(34),"")
'Single turned comma quotation mark 145
Array_Users(t) = Replace(Array_Users(t),chr(145),"")
'Single comma quotation mark 146
Array_Users(t) = Replace(Array_Users(t),chr(146),"")
'Double turned comma quotation mark 147
Array_Users(t) = Replace(Array_Users(t),chr(147),"")
'Double comma quotation mark 148
Array_Users(t) = Replace(Array_Users(t),chr(148),"")
'Replace #machine# with actual machine name if its in the string
Array_Users(t) = Replace(ucase(Array_Users(t)),"#MACHINE#", strDefaultDomain)
Set objTempTrustee = SetTrustee(Array_Users(t))
If blnErrorOccurred(" occurred Setting objTempTrustee = SetTrustee(Array_Users(t))") Then Exit Do
If objTempTrustee Is Nothing then
Call PrintMsg("Could not find " & strAction & " user/group: """ & Array_Users(t) & """ removing from list.")
Array_Users(t) = ""
Else
strTempName = TrusteesDisplay(objTempTrustee)
Call AddObjectToArray(Array_ObjTrustee, objTempTrustee, t)
If IsNull(objTempTrustee.Domain) then objTempTrustee.Domain = ""
If UCase(Array_Users(t)) <> UCASE(strTempName) then
Call PrintMsg(" - Changing " & strAction & " user/group: """ & Array_Users(t) & """ to """ & strTempName & """")
End if
Array_Users(t) = strTempName
Set objTempTrustee = Nothing
End if
End if
Next
FixListOfTrustees = TRUE 'Means we didn't have an error and went through the entire list
Exit Do 'We really didn't want to loop
Loop
Set objTempTrustee = Nothing
If debug_on then Call PrintMsg("FixListOfTrustees: Return = " & FixListOfTrustees)
Call blnErrorOccurred(" occurred while in the FixListOfTrustees routine.")
If debug_on then Call PrintMsg("FixListOfTrustees: Exit")
End Function
'********************************************************************
'*
'* Sub GetDaclArray()
'* Purpose: Return Dacl Array object if found
'* Input: objArrayPassedIn, objSecDescriptor, getonlyInherited
'* Output: Dacl Array Object
'*
'********************************************************************
Sub GetDaclArray(DACL_Array, objSecDescriptor, getonlyInherited)
ON ERROR RESUME NEXT
If debug_on then Call PrintMsg("GetDaclArray: Enter")
Dim TempDACL_Array, objDACL_Member, numControlFlags, ReturnAceFlags
'Put statements in loop to be able to drop out and clear variables
Do
numControlFlags = objSecDescriptor.ControlFlags
If blnErrorOccurred(" occurred getting ControlFlags.") Then Exit Do
TempDACL_Array = objSecDescriptor.DACL
If blnErrorOccurred(" occurred getting Temporary DACL array.") Then Exit Do
If IsArray(TempDACL_Array) then
For Each objDACL_Member in TempDACL_Array
If blnErrorOccurred(" occurred while looping through TempDACL_Array.") Then Exit Do
If getonlyInherited then
If StringAceFlag(objDACL_Member.AceFlags, numControlFlags, SE_DACL_AUTO_INHERITED, TRUE, ReturnAceFlags) = "Inherited" then Call AddObjectToArray(DACL_Array, objDACL_Member, -1)
Else
Call AddObjectToArray(DACL_Array, objDACL_Member, -1)
End If
Next
End if
If (UBound(DACL_Array) = 0) Then
Set DACL_Array(0) = CreateObject("AccessControlEntry")
If blnErrorOccurred(" occurred Setting DACL_Array(0) = CreateObject(""AccessControlEntry"").") Then Exit Do
End if
Exit Do 'We really didn't want to loop
Loop
'ClearObjects that could be set and aren't needed now
Set objDACL_Member = Nothing
Call blnErrorOccurred(" occurred while in the GetDaclArray routine.")
If debug_on then Call PrintMsg("GetDaclArray: Exit")
End Sub
'********************************************************************
'* Function SetTrustee()
'* Purpose: Returns Win32_Trustee object for User/group or Nothing if not found
'* Input: strFullName
'* Output: Win32_Trustee object is returned, Nothing if not found
'********************************************************************
Function SetTrustee(strFullName)
ON ERROR RESUME NEXT
If debug_on then Call PrintMsg("SetTrustee
|
|
Top
|
|
|
|
#212085 - 2016-11-08 11:35 AM
Re: XCACLS VB script v2.7 replacement for the executeable
[Re: Lonkero]
|
Varsha
Just in Town
Registered: 2016-11-08
Posts: 1
Loc: India
|
Can someone let me know what changes are to be made in the above code, to enable Inheritance ?
|
|
Top
|
|
|
|
Moderator: Shawn, ShaneEP, Ruud van Velsen, Arend_, Jochen, Radimus, Glenn Barnas, Allen, Mart
|
0 registered
and 366 anonymous users online.
|
|
|
