ADsSecurityUtility in vbscript
JJ Streicher-Bremer
have started out with what, I thought, was an easy example. I am simply
trying to read the ACLs on a file. I am planning on using the
ADsSecurityUtility interface as I am running on XP. Here is my script:
Dim sd
Dim sdUtil
set sdUtil = CreateObject ("ADsSecurityUtility")
set sd = sdUtil.GetSecurityDescriptor("FILE://c:\temp\foo.zip")
wscript.echo sd.owner
I pulled the syntax of the GetSecurityDescriptor call from examples posted
for using the ADsSecurity.dll. I get an error like this:
acls.vbs(4, 1) Microsoft VBScript runtime error: Wrong number of arguments
or invalid property assignment: 'GetSecurityDescriptor'
When I try to use syntax as provided in other examples (and the MSDN site)
my call looks like this:
set sd = sdUtil.GetSecurityDescriptor("c:\temp\foo.zip", ADS_PATH_FILE,
ADS_SD_FORMAT_IID)
and the error looks like this:
acls.vbs(4, 1) Microsoft VBScript runtime error: Invalid procedure call or
argument
What do I need to do to get the ADsSecurityUtility interface working?
Thanks in advance
JJ Streicher-Bremer
Torgeir Bakken (MVP)
> When I try to use syntax as provided in other examples (and the MSDN site)
> my call looks like this:
> set sd = sdUtil.GetSecurityDescriptor("c:\temp\foo.zip", ADS_PATH_FILE,
> ADS_SD_FORMAT_IID)
>
> and the error looks like this:
> acls.vbs(4, 1) Microsoft VBScript runtime error: Invalid procedure call or
> argument
>
> What do I need to do to get the ADsSecurityUtility interface working?
Hi
You need to define the consts that you are using (ADS_PATH_FILE and
ADS_SD_FORMAT_IID).
Add e.g. this at the top of your script:
' Used by IADsSecurityUtility
const ADS_PATH_FILE = 1
const ADS_PATH_FILESHARE = 2
const ADS_PATH_REGISTRY = 3
' Format the a SecurityDescriptor is retrieved in
const ADS_SD_FORMAT_IID = 1
const ADS_SD_FORMAT_RAW = 2
const ADS_SD_FORMAT_HEXSTRING = 3
--
torgeir
Microsoft MVP Scripting and WMI, Porsgrunn Norway
Administration scripting examples and an ONLINE version of the 1328 page
Scripting Guide: http://www.microsoft.com/technet/scriptcenter
JJ Streicher-Bremer
This is working now.
<RANT>
Why, oh, why can't the vbscript or vb examples provided my MSDN be fully
working examples? This is my major beef with the MS scripting technologies
VS perl, python, etc. The documentation and examples are usually incomplete
and misleading.
</RANT>
I really appreciate your help in this.
Thanks again
JJ Streicher-Bremer
"Torgeir Bakken (MVP)" <Torgeir.B...@hydro.com> wrote in message
news:3F8C7FC5...@hydro.com...
Simon R
a Windows installer installation attached is the code, I beleive it
addresses the issues you have experienced
Option Explicit
' Define ADS_RIGHTS_ENUM constants
Const ADS_RIGHT_DELETE = &h10000
Const ADS_RIGHT_READ_CONTROL = &h20000
Const ADS_RIGHT_WRITE_DAC = &h40000
Const ADS_RIGHT_WRITE_OWNER = &h80000
Const ADS_RIGHT_SYNCHRONIZE = &h100000
Const ADS_RIGHT_ACCESS_SYSTEM_SECURITY = &h1000000
Const ADS_RIGHT_GENERIC_READ = &h80000000
Const ADS_RIGHT_GENERIC_WRITE = &h40000000
Const ADS_RIGHT_GENERIC_EXECUTE = &h20000000
Const ADS_RIGHT_GENERIC_ALL = &h10000000
Const ADS_RIGHT_DS_CREATE_CHILD = &h1
Const ADS_RIGHT_DS_DELETE_CHILD = &h2
Const ADS_RIGHT_ACTRL_DS_LIST = &h4
Const ADS_RIGHT_DS_SELF = &h8
Const ADS_RIGHT_DS_READ_PROP = &h10
Const ADS_RIGHT_DS_WRITE_PROP = &h20
Const ADS_RIGHT_DS_DELETE_TREE = &h40
Const ADS_RIGHT_DS_LIST_OBJECT = &h80
Const ADS_RIGHT_DS_CONTROL_ACCESS = &h100
Const ADS_RIGHT_REG_READ = &H20019
Const ADS_RIGHT_REG_FULL = &HF003F
' Define ADS_ACETYPE_ENUM constants
Const ADS_ACETYPE_ACCESS_ALLOWED = 0
Const ADS_ACETYPE_ACCESS_DENIED = &h1
Const ADS_ACETYPE_SYSTEM_AUDIT = &h2
Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &h5
Const ADS_ACETYPE_ACCESS_DENIED_OBJECT = &h6
Const ADS_ACETYPE_SYSTEM_AUDIT_OBJECT = &h7
' Define ADS_ACEFLAG_ENUM Constants
Const OBJECT_INHERIT_ACE = &h1
Const ADS_ACEFLAG_INHERIT_ACE = &h2
Const ADS_ACEFLAG_NO_PROPAGATE_INHERIT_ACE = &h4
Const ADS_ACEFLAG_INHERIT_ONLY_ACE = &h8
Const ADS_ACEFLAG_INHERITED_ACE = &h10
Const ADS_ACEFLAG_VALID_INHERIT_FLAGS = &h1f
Const ADS_ACEFLAG_SUCCESSFUL_ACCESS = &h40
Const ADS_ACEFLAG_FAILED_ACCESS = &h80
' Define ADS_PATH_ENUM constants
Const ADS_PATH_FILE = 1
Const ADS_PATH_FILESHARE = 2
Const ADS_PATH_REGISTRY = 3
' Define ADS_SD_FORMAT_ENUM constants
Const ADS_SD_FORMAT_IID = 1
Const ADS_SD_FORMAT_RAW = 2
Const ADS_SD_FORMAT_HEXSTRING = 3
Dim lAceFlag
'=============================================================================
' Windows Installer Section
Const ERROR_SUCCESS = 0
Const ERROR_INSTALL_FAILURE = 1603
Const ERROR_FUNCTION_FAILED = 1627
Dim sMsgBoxTitle : sMsgBoxTitle = "Installing " &
Session.Property("ProductName") & _
" - version " &
Session.Property("ProductVersion")
Function EditFilePerms()
EditFilePerms = ERROR_SUCCESS
If Session.Property("REMOVE") = "" Then
DACL "Add", "FILE://" & Session.Property("INSTALLDIR"),
Session.Property("CUSTOMPERMS1")
If Err.Number > ERROR_SUCCESS Then
EditFilePerms = ERROR_INSTALL_FAILURE
Exit Function
End If
Else
' DACL "Add", "FILE://" & Session.Property("INSTALLDIR"),
Session.Property("CUSTOMPERMS1")
' If Err.Number > ERROR_SUCCESS Then
' EditFilePerms = ERROR_INSTALL_FAILURE
' Exit Function
' End If
End If
End Function
'=============================================================================
' Usage: DACL Action, Object, "Ace"
'
' Action: Add Add ACE To ACL
' Remove Remove ACE from ACL
' Set Overwrite ACL
'
' Object: FILE://Target Change this File/Folder only
' e.g. File://c:\Program Files\Test\Test.ini Or
File://c:\Program Files\Test
'
' FILE://TargetFolder\ Change this folder, subfolder &
files
' e.g. File://c:\Program Files\Test\
'
' FILE://TargetFolder\\ Change this folder and subfolders
only
' e.g. File://c:\Program Files\Test\\
'
' RGY://\TargetKey Change this Key, individual registry
values have no ACL's assigned
' e.g. RGY:// HKEY_LOCAL_MACHINE\SOFTWARE
'
' "Ace": "Account:Rights"
'
' Account: User Or Group
'
' Rights: File/Folder
' F Full Control
' C Change
' S Read + Write + Execute
' R Read + Execute
' L List
'
' Registry
' F Full Control
' R Read
'
' Examples:
' Grant 'Power Users' "Change" to the file "Test.ini" only
' DACL "Add", "FILE://c:\Program Files\Test\Test.ini", "Power Users:C"
'
' Grant 'Power Users' "Change" to the folder "Test" only
' DACL "Add", "FILE://c:\Program Files\Test", "Power Users:C"
'
' Grant 'Power Users' "Change" to the folder "Test", subfolders &
files
' DACL "Add", "FILE://c:\Program Files\Test\", "Power Users:C"
'
' Grant 'Power Users' "Change" to the folder "Test" & subfolders
' DACL "Add", "FILE://c:\Program Files\Test\\", "Power Users:C"
'
' Grant 'Users' "Read" to the key "Test"
' DACL "Add", "RGY://HKEY_LOCAL_MACHINE\SOFTWARE\Test", "Users:R"
'
' Grant 'Power Users' "Full Control" to the key "Test"
' DACL "Add", "RGY://HKEY_LOCAL_MACHINE\SOFTWARE\Test", "Power
Users:F"
'
'=============================================================================
Sub DACL(sAction, sParameters, sAcl)
Dim oParameters, sObjectType, sObjectPath,sTree, _
oFSO, oFile, oFolder, oRoot, sFileType, oRO, oRegKey, oSubkey
oParameters = Split(sParameters,"://")
sObjectType = oParameters(0)
sObjectPath = oParameters(1)
If Right(sObjectPath,2) = "\\" Then
sTree = "\\" ' SubFolders only
sObjectPath = Left(sObjectPath, Len(sObjectPath)-2)
ElseIf Right(sObjectPath,1) = "\" Then
sTree = "\" ' SubFolders and Files
sObjectPath = Left(sObjectPath, Len(sObjectPath)-1)
End If
If sObjectType = "FILE" Then
Set oFSO=CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists(sObjectPath) Then
Set oRoot=oFSO.GetFile(sObjectPath)
sFileType = "FILE"
ElseIf oFSO.FolderExists(sObjectPath) Then
Set oRoot=oFSO.GetFolder(sObjectPath)
sFileType = "FOLDER"
Else
MsgBox "Cannot find " & sObjectPath, vbCritical, sMsgBoxTitle
Err.Raise Err.Number
Exit Sub
End If
AclEdit sAction, oRoot.Path, sAcl, sFileType
If sFileType = "FILE" Then
Exit Sub
End If
If sTree = "\" Then
lAceFlag = ADS_ACEFLAG_INHERITED_ACE
For Each oFile In oRoot.Files
AclEdit sAction, oFile.Path , sAcl, "FILE"
Next
End If
If sTree = "\" Or sTree = "\\" Then
lAceFlag = ADS_ACEFLAG_INHERITED_ACE
For Each oFolder In oRoot.SubFolders
DACL sAction, "FILE://" & oFolder & sTree, sAcl
Next
End If
ElseIf sObjectType = "RGY" Then
AclEdit sAction, sObjectPath, sAcl,"REGISTRY"
Else
MsgBox "Unsupported Object Type: " & sObjectType, vbCritical,
sMsgBoxTitle
Err.Raise Err.Number
End If
On Error Goto 0
End Sub
Sub AclEdit( sAction, sObject, sAcl, sObjectType )
Dim oADsec, oSecDes, oDacl, oAclSplit, oTemp, oAce, oAceSplit, _
oUserSplit, oTempSplit, sUser, sPerm
Set oADsec = CreateObject("ADsSecurityUtility")
On Error Resume Next
If sObjectType = "REGISTRY" Then
Set oSecDes = oADsec.GetSecurityDescriptor(
sObject,ADS_PATH_REGISTRY,ADS_SD_FORMAT_IID )
Else
Set oSecDes = oADsec.GetSecurityDescriptor(
sObject,ADS_PATH_FILE,ADS_SD_FORMAT_IID )
End If
If ErrHandler("Get SD for " & sObject ) Then
On Error Goto 0
Exit Sub
End If
Set oDacl = oSecDes.DiscretionaryAcl
oTemp = oDacl.AceCount
If ErrHandler("Get DACL for " & sObject ) Then
On Error Goto 0
Exit Sub
End If
oAclSplit = Split(sAcl,",")
If sAction = "Remove" Or sAction = "Add" Then
For Each oAce In oDacl
oAceSplit = Split (LCase(oAce.Trustee & "\" & oAce.Trustee),"\")
If oAceSplit(0) <> "nt authority" Then
For Each sUser In oAclSplit
oUserSplit = Split (LCase(sUser),":")
If oAceSplit(1) = oUserSplit(0) Then
oDacl.RemoveAce oAce
ErrHandler("Remove ACE for " & oAce.Trustee & " from " &
sObject)
End If
Next
End If
Next
ElseIf sAction = "Set" Then
For Each oAce In oDacl
oAceSplit = Split (LCase(oAce.Trustee & "\" & oAce.Trustee),"\")
If oAceSplit(0) <> "nt authority" Then
oDacl.RemoveAce oAce
ErrHandler("Remove ACE for " & oAce.Trustee & " from " &
sObject)
End If
Next
Else
MsgBox "Unknown Action: " & sAction, vbCritical, sMsgBoxTitle
Err.Raise Err.Number
End If
If sAction = "Set" Or sAction = "Add" Then
For Each oTemp In oAclSplit
oTempSplit = Split (oTemp,":")
sUser = oTempSplit(0)
sPerm = oTempSplit(1)
Select Case sObjectType
Case "FOLDER"
AddFileAce oDacl, sUser, sPerm, ADS_ACETYPE_ACCESS_ALLOWED,
lAceFlag Or ADS_ACEFLAG_INHERIT_ACE Or OBJECT_INHERIT_ACE
Case "FILE"
AddFileAce oDacl, sUser, sPerm, ADS_ACETYPE_ACCESS_ALLOWED,
lAceFlag
Case "REGISTRY"
AddRegAce oDacl, sUser, sPerm, ADS_ACETYPE_ACCESS_ALLOWED,
lAceFlag
End Select
Next
End If
oSecDes.DiscretionaryAcl = oDacl
If ErrHandler("Get SD for " & sObject ) Then
On Error Goto 0
Exit Sub
End If
If sObjectType = "REGISTRY" Then
oADsec.SetSecurityDescriptor sObject, ADS_PATH_REGISTRY, oSecDes,
ADS_SD_FORMAT_IID
Else
oADsec.SetSecurityDescriptor sObject, ADS_PATH_FILE, oSecDes,
ADS_SD_FORMAT_IID
End If
If ErrHandler("Set SD for " & sObject ) Then
On Error Goto 0
Exit Sub
End If
Set oADsec = Nothing
Set oSecDes = Nothing
Set oDacl = Nothing
On Error Goto 0
End Sub
Sub AddFileAce(oDacl, sUser, sPerm, lAceType, lAceflags)
Dim oAce : Set oAce = CreateObject("AccessControlEntry")
oAce.Trustee = sUser
Select Case UCase(sPerm)
Case "F"
oAce.AccessMask = ADS_RIGHT_GENERIC_ALL
Case "C"
oAce.AccessMask = ADS_RIGHT_GENERIC_READ Or
ADS_RIGHT_GENERIC_EXECUTE Or _
ADS_RIGHT_GENERIC_WRITE Or ADS_RIGHT_DELETE
Case "S"
oAce.AccessMask = ADS_RIGHT_GENERIC_READ Or
ADS_RIGHT_GENERIC_EXECUTE Or _
ADS_RIGHT_GENERIC_WRITE
Case "R"
oAce.AccessMask = ADS_RIGHT_GENERIC_READ Or
ADS_RIGHT_GENERIC_EXECUTE
Case "L"
oAce.AccessMask = ADS_RIGHT_GENERIC_READ
End Select
oAce.AceType = lAceType
oAce.AceFlags = lAceflags
oDacl.AddAce oAce
ErrHandler("Add Ace for " & SUser )
Set oAce = Nothing
End Sub
Sub AddRegACE(oDacl, sUser, sPerm , lAceType, lAceflags)
Dim oAce : Set oAce = CreateObject("AccessControlEntry")
oAce.Trustee = sUser
Select Case UCase(sPerm)
Case "F"
oAce.AccessMask = ADS_RIGHT_REG_FULL
Case "R"
oAce.AccessMask = ADS_RIGHT_REG_READ
End Select
oAce.AceType = lAceType
oAce.AceFlags = lAceflags
oDacl.AddAce oAce
ErrHandler("Add Ace for " & sUser )
Set oAce=Nothing
End Sub
Function ErrHandler(sError)
If Err.Number > 0 Then
MsgBox sError & " Error " & Err.Number & ": " & Err.Description,
vbCritical, sMsgBoxTitle
Err.Clear
Return True
End If
ErrHandler = False
End Function
Max L. Vaughn [MSFT]
When using this object against registry keys, you get an access denied
error. This is caused by the way the object opens the registry key. The
problem has been documented with microsoft and is in the process of being
fixed.
Sincerely,
Max Vaughn [MS]
Microsoft Developer Support
Disclaimer: This posting is provided "AS IS" with no warranties, and
confers no rights. You assume all risk for your use.