Const KEY_QUERY_VALUE = &H0001
Const KEY_SET_VALUE = &H0002
Const KEY_CREATE_SUB_KEY = &H0004
Const DELETE = &H00010000
 
Const HKEY_LOCAL_MACHINE = &H80000002
 
strComputer = "."

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
    strComputer & "\root\default:StdRegProv")
 
strKeyPath = "SYSTEM\CurrentControlSet"
 
oReg.CheckAccess HKEY_LOCAL_MACHINE, strKeyPath, KEY_QUERY_VALUE, _
    bHasAccessRight
If bHasAccessRight = True Then
    Wscript.Echo "Have Query Value Access Rights on Key"
Else
    Wscript.Echo "Do Not Have Query Value Access Rights on Key"
End If   
 
oReg.CheckAccess HKEY_LOCAL_MACHINE, strKeyPath, KEY_SET_VALUE, _
    bHasAccessRight
If bHasAccessRight = True Then
    Wscript.Echo "Have Set Value Access Rights on Key"
Else
    Wscript.Echo "Do Not Have Set Value Access Rights on Key"
End If   
 
oReg.CheckAccess HKEY_LOCAL_MACHINE, strKeyPath, KEY_CREATE_SUB_KEY, _
    bHasAccessRight
If bHasAccessRight = True Then
    Wscript.Echo "Have Create SubKey Access Rights on Key"
Else
    StdOut.WriteLine "Do Not Have Create SubKey Access Rights on Key"
End If
 
oReg.CheckAccess HKEY_LOCAL_MACHINE, strKeyPath, DELETE, bHasAccessRight
If bHasAccessRight = True Then
    StdOut.WriteLine "Have Delete Access Rights on Key"
Else
    StdOut.WriteLine "Do Not Have Delete Access Rights on Key"
End If

    Dim strComputer As String
    Dim strKeyPath As String
    
    strComputer = "."

    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")
 
    strKeyPath = "SOFTWARE\BudgetBackUp"

Private Sub Command1_Click()

    Dim rslt As Boolean
    Dim FirstAddReadMask As Long, SecondAddReadMask As Long
    
    Dim strComputer As String
    Dim strKeyPath As String
    Dim Oreg As Object
    
    strComputer = "."

    Set Oreg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")
 
    strKeyPath = "SOFTWARE\BudgetBackUp"
    
    Oreg = Oreg + "\" + strKeyPath
    
    
    ' Add & Read
    'FirstAddReadMask = GENERIC_EXECUTE Or GENERIC_READ
    'SecondAddReadMask = READ_CONTROL Or SYNCHRONIZE Or &H1BF
                        ' (&h01bf standard rights for folder)
    'rslt = ChangePermission(Text1.Text, FirstAddReadMask, _
    '    SecondAddReadMask)
    'If Not rslt Then
    '    MsgBox "ChangePermission failed"
    'End If
    
End Sub

Private Function ChangePermission(sFName As String, FirstAceMask As Long, SecondAceMask As Long) As Boolean
   
   ' This function will set permissions for Folder specified in sFName
   ' FirstAceMask will set the mask for the files in the folder
   ' SecondAceMask will set the mask for the folder and subfolders.
   
   Dim udtSidIdentifierAuthority As SID_IDENTIFIER_AUTHORITY
   Dim udtAccessAllowedAce As ACCESS_ALLOWED_ACE
   Dim pSid As Long, ACLSize As Long
   Dim lAceSize As Long
   Dim x As Long
   Dim i As Integer
      
   ' To assign permissions you need to be a member of the
   ' Administrators group and the folder must be on an NTFS partition.
   For i =  0  To  4 
       udtSidIdentifierAuthority.Value(i) =  0 
   Next i
   udtSidIdentifierAuthority.Value( 5 ) =  5   ' SECURITY_NT_AUTHORITY
      
   Dim psdl As Long ' used to get security descriptor pointer
   
   ' Initialize Security Descriptor - the first paramter is address of the
   ' security descriptor.
   x = InitializeSecurityDescriptor(VarPtr(psdl), _
       SECURITY_DESCRIPTOR_REVISION)
   If x =  0  Then
       MsgBox "InitializeSecurityDescriptor failed"
       Exit Function
   End If
   
   ' Allocate and initialize a Sid; Administrative group
   ' The first parameter is the Sid Authority Identifier which identifies
   '    the top level authority which is the administrators group.
   ' The second parameter indicates that there are 2 subauthorities to
   '    be placed in the SID.
   ' The two subauthorities SECURITY_BUILTIN_DOMAIN_RID and
   '    DOMAIN_ALIAS_RID_ADMINS are RID identifiers for the
   '    Administrators group.
   ' The RID is the Relative Identifier found in the SID that identifies
   '    the user or group.  In this case it identifies the Administrators
   '    group.
   ' The combinded SID and RIDs identify the Administrators group.
   ' The last paramter, pSid is a pointer to a pointer to the sid.
   '    It is passed byref here and later dereferenced passing byval.
   '    It is passed byval in GetLengthSid, CopySid and FreeSid.
   x = AllocateAndInitializeSid(udtSidIdentifierAuthority,  2 , _
            SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, _
             0 ,  0 ,  0 ,  0 ,  0 ,  0 , pSid)
   If x =  0  Then
       MsgBox "AllocateAndInitializeSid failed"
       Exit Function
   End If
   
   ' Calculate length of ACL
   Dim AnAcl As ACL, AnAAA As ACCESS_ALLOWED_ACE
   
   ACLSize = Len(AnAcl) + Len(AnAAA) - Len(x) + GetLengthSid(pSid) + _
           Len(AnAAA) - Len(x) + GetLengthSid(pSid)
    
   ' Allocate memory for ACL
   ReDim bufACL(ACLSize -  1 ) As Byte
   
   ' Init the ACL
   ' Creates a new ACL structure.  This is a variable length structure.
   ' A byte array is created to hold the contiguous bytes.  The size of
   ' this buffer was calculated above in ACLSize.  In this call the pointer
   ' to the first element of the array is passed.
   ' The third parameter must be ACL_REVISION.
   x = InitializeAcl(bufACL( 0 ), ACLSize, ACL_REVISION)
   If x =  0  Then
       MsgBox "InitializeAcl failure"
       Exit Function
   End If
     
   ' Set values in AllowedAccessAce structure:
   ' It is easier to assign values using UDT notation.
   ' There are 2 types of ACEs.  Access allowed and Access denied.
   ' This field indicates that we are using an Access allowed ACE.
   udtAccessAllowedAce.Header.AceType = ACCESS_ALLOWED_ACE_TYPE
   ' AceFlags field specifies control flags.
   ' INHERIT_ONLY_ACE does not apply to containers (folder) but to objects
   ' in the container (files).
   ' OBJECT_INHERIT_ACE indicates that the ACE is inherited by
   ' non container objects such as files within the container object
   ' to which the ACE is assigned.
   udtAccessAllowedAce.Header.AceFlags = _
       INHERIT_ONLY_ACE Or OBJECT_INHERIT_ACE
   ' Size of the ACE
   lAceSize = Len(AnAAA) - Len(x) + GetLengthSid(pSid)
   udtAccessAllowedAce.Header.AceSize = lAceSize
   ' The Mask specifies access rights granted to the ACE.
   ' See SDK documentation under ACCESS_MASK for the break down by bits.
   udtAccessAllowedAce.Mask = FirstAceMask
   ReDim bufAce(lAceSize -  1 ) As Byte
   ' Copy the AccessAllowedAce structure(UDT) to buffer.
   CopyMemory bufAce( 0 ), udtAccessAllowedAce, lAceSize
   ' Copy sid to buffer where bufAce is the destination buffer -
   ' pSid is ptr to source SID.
   ' y(8) corresponds to SidStart field in AccessAllowedAce struct.
   x = CopySid(GetLengthSid(pSid), bufAce( 8 ), pSid)
    If x =  0  Then
       MsgBox "CopySid fail " & Err.LastDllError
       Exit Function
    End If
       
    ' Add an ACE to ACL.  This is done twice.
    ' This first AddAce call applies to files in the folder.
    ' The first parameter is a pointer to the variable length ACL which is
    '     passed using a pointer to the first element in a byte array.
    ' The second parameter needs to be ACL_REVISION.
    ' The third paramter specifies the position of the ACE in the
    '    ACL which in this case is at the end.
    ' The fourth parameter is a pointer to one or more ACEs.
    '    These ACEs would be placed in contiguous memory and are
    '    placed in a byte array the size
    ' which is placed in the last parameter.
    x = AddAce(bufACL( 0 ), ACL_REVISION, MAXDWORD, bufAce( 0 ), _
        udtAccessAllowedAce.Header.AceSize)
    If x =  0  Then
        MsgBox "First AddAce failed " & Err.LastDllError
    End If
    
    CopyMemory udtAccessAllowedAce, bufAce( 0 ), _
        udtAccessAllowedAce.Header.AceSize
        
    udtAccessAllowedAce.Mask = SecondAceMask
    udtAccessAllowedAce.Header.AceFlags = CONTAINER_INHERIT_ACE

    CopyMemory bufAce( 0 ), udtAccessAllowedAce, _
        udtAccessAllowedAce.Header.AceSize
   
    
    ' bufACL(0) - ptr to first element in byte array that
    ' contains contents of the acl structure - ACE gets added to this ACL
    ' which contains ACEs stored contiguously.
    ' This ACE applies to directories and subdirectories.
        
    x = AddAce(bufACL( 0 ), ACL_REVISION, MAXDWORD, bufAce( 0 ), _
        udtAccessAllowedAce.Header.AceSize)
    If x =  0  Then
        MsgBox "Second AddAce failed " & Err.LastDllError
    End If
        
    ' Set the DACL in the security descriptor
    ' The first paramter is the pointer to the security descriptor.
    ' The second paramter is boolean indicating the presence of a DACL
    ' in the Security Descriptor.
    ' The third parameter is the address of the DACL which is variable
    ' length and passed in a byte array.
    ' The fourth paramter indicates that DACL is created by user.
    x = SetSecurityDescriptorDacl(VarPtr(psdl),  1 , bufACL( 0 ),  0 )
    If x =  0  Then
       MsgBox "SetSecurityDescriptorDacl failure " & Err.LastDllError
       Exit Function
    End If
    
    Dim si As Long
    si = DACL_SECURITY_INFORMATION
   
    ' Set security on Folder object
    x = SetFileSecurity(sFName, si, VarPtr(psdl))
    If x =  0  Then
        MsgBox "SetFileSecurity failure " & Err.LastDllError
        Exit Function
    End If
    
    ' Free Sid
    FreeSid pSid
    
    ChangePermission = True
    
End Function