Attribute VB_Name = "Module1"
Option Explicit

' Constants used within our API calls. Refer to the MSDN for more
' information on how/what these constants are used for.

' Memory constants used by various memory API calls.
Private Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const LPTR = (LMEM_FIXED + LMEM_ZEROINIT)

'Generic Access Rights
Public Const GENERIC_ALL = &H10000000
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_EXECUTE = &H20000000
Public Const GENERIC_WRITE = &H40000000

'Standard Access Rights
Public Const DELETE = &H10000
Public Const READ_CONTROL = &H20000
Public Const WRITE_DAC = &H40000
Public Const WRITE_OWNER = &H80000
Public Const SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const STANDARD_RIGHTS_READ = READ_CONTROL
Public Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Public Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const SPECIFIC_RIGHTS_ALL = &HFFFF&
Public Const ACCESS_SYSTEM_SECURITY = &H1000000
Public Const MAXIMUM_ALLOWED = &H2000000

' Constants to be used in API calls. Refer to the MSDN for more
' information on how/what these constants are used for.
Private Const DACL_SECURITY_INFORMATION = &H4
Private Const SECURITY_DESCRIPTOR_REVISION = 1
Private Const SECURITY_DESCRIPTOR_MIN_LENGTH = 20
Private Const SD_SIZE = (65536 + SECURITY_DESCRIPTOR_MIN_LENGTH)
Private Const ACL_REVISION2 = 2
Private Const ACL_REVISION = 2
Private Const MAXDWORD = &HFFFFFFFF
Private Const SidTypeUser = 1
Private Const AclSizeInformation = 2

' The following are the inherit flags that go into the AceFlags
' field of an Ace header.
Public Const OBJECT_INHERIT_ACE = &H1
Public Const CONTAINER_INHERIT_ACE = &H2
Public Const NO_PROPAGATE_INHERIT_ACE = &H4
Public Const INHERIT_ONLY_ACE = &H8
Public Const INHERITED_ACE = &H10
Public Const VALID_INHERIT_FLAGS = &H1F

' The following are the security descriptor flags.
Private Const SE_DACL_AUTO_INHERIT_REQ = &H100
Private Const SE_SACL_AUTO_INHERIT_REQ = &H200
Private Const SE_DACL_AUTO_INHERITED = &H400
Private Const SE_SACL_AUTO_INHERITED = &H800
Private Const SE_DACL_PROTECTED = &H1000
Private Const SE_SACL_PROTECTED = &H2000

' Type of ACE being added.
Public Const ACCESS_ALLOWED_ACE_TYPE = 0
Public Const ACCESS_DENIED_ACE_TYPE = 1

'
' Constants from WINNT.H for the various well-known SIDs, users and groups
'
Public Const SECURITY_WORLD_SID_AUTHORITY = &H1
Public Const SECURITY_NT_AUTHORITY = &H5

Public Const SECURITY_BUILTIN_DOMAIN_RID = &H20&
Public Const DOMAIN_ALIAS_RID_ADMINS = &H220&
Public Const DOMAIN_ALIAS_RID_USERS = &H221&
Public Const SECURITY_LOCAL_SYSTEM_RID = &H12
Public Const SECURITY_WORLD_RID = &H0

Public Const DOMAIN_USER_RID_ADMIN = &H1F4
Public Const DOMAIN_USER_RID_GUEST = &H1F5

Public Const DOMAIN_GROUP_RID_ADMINS = &H200

Public Const INVALID_HANDLE_VALUE = -1
Public Const OPEN_EXISTING = 3
Public Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000

'Folder Specific Access Rights
Public Const FILE_LIST_DIRECTORY = &H1&            ' directory
Public Const FILE_ADD_FILE = &H2&                  ' directory
Public Const FILE_ADD_SUBDIRECTORY = &H4&          ' directory
Public Const FILE_TRAVERSE = &H20&                 ' directory
Public Const FILE_DELETE_CHILD = &H40&             ' directory

Public Const FILE_READ_DATA = &H1&                 ' file
Public Const FILE_WRITE_DATA = &H2&                ' file
Public Const FILE_APPEND_DATA = &H4&               ' file
Public Const FILE_EXECUTE = &H20&                  ' file

Public Const FILE_READ_EA = &H8&                   ' file & directory
Public Const FILE_WRITE_EA = &H10&                 ' file & directory

Public Const FILE_READ_ATTRIBUTES = &H80&          ' all
Public Const FILE_WRITE_ATTRIBUTES = &H100&        ' all

' Generic access masks for files
Public Const FILE_ALL_ACCESS As Long = _
    STANDARD_RIGHTS_REQUIRED Or _
    SYNCHRONIZE Or _
    511
Public Const FILE_GENERIC_READ  As Long = _
    STANDARD_RIGHTS_READ Or _
    FILE_READ_DATA Or _
    FILE_READ_ATTRIBUTES Or _
    FILE_READ_EA Or _
    SYNCHRONIZE
Public Const FILE_GENERIC_WRITE As Long = _
    STANDARD_RIGHTS_WRITE Or _
    FILE_WRITE_DATA Or _
    FILE_WRITE_ATTRIBUTES Or _
    FILE_WRITE_EA Or _
    FILE_APPEND_DATA Or _
    SYNCHRONIZE
Public Const FILE_GENERIC_EXECUTE As Long = _
    STANDARD_RIGHTS_EXECUTE Or _
    FILE_READ_ATTRIBUTES Or _
    FILE_EXECUTE Or _
    SYNCHRONIZE

' Registry access masks
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_WOW64_32KEY = &H200
Public Const KEY_WOW64_64KEY = &H100

Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
                            KEY_QUERY_VALUE Or _
                            KEY_ENUMERATE_SUB_KEYS Or _
                            KEY_NOTIFY) _
                            And (Not SYNCHRONIZE))
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
                            KEY_SET_VALUE Or _
                            KEY_CREATE_SUB_KEY) _
                            And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
                                KEY_QUERY_VALUE Or _
                                KEY_SET_VALUE Or _
                                KEY_CREATE_SUB_KEY Or _
                                KEY_ENUMERATE_SUB_KEYS Or _
                                KEY_NOTIFY Or _
                                KEY_CREATE_LINK) _
                                And (Not SYNCHRONIZE))

' Registry constants
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003

' WindowStation and Desktop access masks
Public Const WINSTA_ENUMDESKTOPS = &H1&
Public Const WINSTA_READATTRIBUTES = &H2&
Public Const WINSTA_ACCESSCLIPBOARD = &H4&
Public Const WINSTA_CREATEDESKTOP = &H8&
Public Const WINSTA_WRITEATTRIBUTES = &H10&
Public Const WINSTA_ACCESSGLOBALATOMS = &H20&
Public Const WINSTA_EXITWINDOWS = &H40&
Public Const WINSTA_ENUMERATE = &H100&
Public Const WINSTA_READSCREEN = &H200&

Public Const DESKTOP_READOBJECTS = &H1&
Public Const DESKTOP_CREATEWINDOW = &H2&
Public Const DESKTOP_CREATEMENU = &H4&
Public Const DESKTOP_HOOKCONTROL = &H8&
Public Const DESKTOP_JOURNALRECORD = &H10&
Public Const DESKTOP_JOURNALPLAYBACK = &H20&
Public Const DESKTOP_ENUMERATE = &H40&
Public Const DESKTOP_WRITEOBJECTS = &H80&
Public Const DESKTOP_SWITCHDESKTOP = &H100&

Public Const WINSTA_ALL_ACCESS = (WINSTA_ACCESSCLIPBOARD Or _
                            WINSTA_ACCESSGLOBALATOMS Or _
                            WINSTA_CREATEDESKTOP Or _
                            WINSTA_ENUMDESKTOPS Or _
                            WINSTA_ENUMERATE Or _
                            WINSTA_EXITWINDOWS Or _
                            WINSTA_READATTRIBUTES Or _
                            WINSTA_READSCREEN Or _
                            WINSTA_WRITEATTRIBUTES)

Public Const DESKTOP_ALL_ACCESS = (DESKTOP_CREATEMENU Or _
                            DESKTOP_CREATEWINDOW Or _
                            DESKTOP_ENUMERATE Or _
                            DESKTOP_HOOKCONTROL Or _
                            DESKTOP_JOURNALPLAYBACK Or _
                            DESKTOP_JOURNALRECORD Or _
                            DESKTOP_READOBJECTS Or _
                            DESKTOP_SWITCHDESKTOP Or _
                            DESKTOP_WRITEOBJECTS)

' Print Server access masks
Public Const SERVER_ACCESS_ADMINISTER = &H1
Public Const SERVER_ACCESS_ENUMERATE = &H2

Public Const SERVER_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or _
                                    SERVER_ACCESS_ADMINISTER Or _
                                    SERVER_ACCESS_ENUMERATE
Public Const SERVER_READ = STANDARD_RIGHTS_READ Or _
                            SERVER_ACCESS_ENUMERATE

Public Const SERVER_WRITE = STANDARD_RIGHTS_WRITE Or _
                            SERVER_ACCESS_ADMINISTER Or _
                            SERVER_ACCESS_ENUMERATE
Public Const SERVER_EXECUTE = STANDARD_RIGHTS_EXECUTE Or _
                                SERVER_ACCESS_ENUMERATE
                              
' Printer access masks
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8

Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
                                    PRINTER_ACCESS_ADMINISTER Or _
                                    PRINTER_ACCESS_USE)
Public Const PRINTER_READ = STANDARD_RIGHTS_READ Or _
                            PRINTER_ACCESS_USE
Public Const PRINTER_WRITE = STANDARD_RIGHTS_WRITE Or _
                            PRINTER_ACCESS_USE
Public Const PRINTER_EXECUTE = STANDARD_RIGHTS_EXECUTE Or _
                            PRINTER_ACCESS_USE

' Print Jobs access masks
Public Const JOB_ACCESS_ADMINISTER = &H10

Public Const JOB_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or _
                                JOB_ACCESS_ADMINISTER
Public Const JOB_READ = STANDARD_RIGHTS_READ Or _
                                JOB_ACCESS_ADMINISTER
Public Const JOB_WRITE = STANDARD_RIGHTS_WRITE Or _
                                JOB_ACCESS_ADMINISTER
Public Const JOB_EXECUTE = STANDARD_RIGHTS_EXECUTE Or _
                                JOB_ACCESS_ADMINISTER
                                
' Other constants
Public Const ERROR_SUCCESS = 0&
Public Const NERR_Success = 0&

' Version Information constant
Private Const VER_PLATFORM_WIN32_NT = &H2

' Types needed for ACL manipulation. Refer to MSDN for more info
Private Type ACL
    AclRevision As Byte
    Sbz1 As Byte
    AclSize As Integer
    AceCount As Integer
    Sbz2 As Integer
End Type
 
Private Type ACL_SIZE_INFORMATION
    AceCount As Long
    AclBytesInUse As Long
    AclBytesFree As Long
End Type

Private Type ACE_HEADER
    AceType As Byte
    AceFlags As Byte
    AceSize As Integer
End Type
 
Private Type ACE
    Header As ACE_HEADER
    Mask As Long
    SidStart As Long
End Type

Private Type SECURITY_ATTRIBUTES
    Length As Long
    SecurityDescriptor As Long
    InheritHandle As Long
End Type
   
Private Type SID_IDENTIFIER_AUTHORITY
    Value(6) As Byte
End Type
   
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
   
Private Type SHARE_INFO_502
        shi502_netname As Long
        shi502_type As Long
        shi502_remark As Long
        shi502_permissions As Long
        shi502_max_uses As Long
        shi502_current_uses As Long
        shi502_path As Long
        shi502_passwd As Long
        shi502_reserved As Long
        shi502_security_descriptor As Long
End Type

Private Type PRINTER_DEFAULTS
    pDatatype As Long
    pDevMode As Long
    DesiredAccess As Long
End Type

Private Type PRINTER_INFO_3
    pSecurityDescriptor As Long
End Type

' Application Types
Public Type AccountPerm
    AccountName As String
    AccessMask As Long
    AceFlags As Byte
    AceType As Byte
    pSid As Long
    SidPassedByCaller As Boolean
End Type
   
Private Type SDMemInfo
    pSD As Long
    pAcl As Long
End Type

Private Declare Function LocalAlloc Lib "kernel32.dll" _
        (ByVal wFlags As Long, ByVal wBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32.dll" _
        (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
        (hpvDest As Any, ByVal hpvSource As Long, _
        ByVal cbCopy As Long)

Private Declare Function InitializeSecurityDescriptor Lib "advapi32.dll" _
    (ByVal pSecurityDescriptor As Long, _
    ByVal dwRevision As Long) As Long
Private Declare Function LookupAccountName Lib "advapi32.dll" Alias _
    "LookupAccountNameA" (ByVal lpSystemName As Long, _
                            ByVal lpAccountName As String, _
                            ByVal Sid As Long, _
                            cbSid As Long, _
                            ByVal ReferencedDomainName As String, _
                            cbReferencedDomainName As Long, _
                            peUse As Long) As Long
Private Declare Function GetLengthSid Lib "advapi32.dll" _
        (ByVal pSid As Long) As Long
Private Declare Function InitializeAcl Lib "advapi32.dll" _
        (ByVal pAcl As Long, ByVal nAclLength As Long, _
        ByVal dwAclRevision As Long) As Long
Private Declare Function SetSecurityDescriptorDacl Lib "advapi32.dll" _
        (ByVal pSecurityDescriptor As Long, ByVal bDaclPresent As Long, _
        ByVal pDacl As Long, ByVal bDaclDefaulted As Long) As Long
Private Declare Function GetAce Lib "advapi32.dll" _
        (ByVal pAcl As Long, ByVal dwAceIndex As Long, pACE As Long) As Long

Private Declare Function GetSecurityDescriptorDacl Lib "advapi32.dll" _
        (ByVal pSecurityDescriptor As Long, lpbDaclPresent As Long, _
        pDacl As Long, lpbDaclDefaulted As Long) As Long
Private Declare Function GetAclInformation Lib "advapi32.dll" _
        (ByVal pAcl As Long, pAclInformation As Any, _
        ByVal nAclInformationLength As Long, _
        ByVal dwAclInformationClass As Long) As Long

Private Declare Function GetSecurityDescriptorControl Lib "advapi32.dll" _
        (ByVal pSecurityDescriptor As Long, _
        pControl As Long, lpdwRevision As Long) As Long
Private Declare Function SetSecurityDescriptorControl Lib "advapi32.dll" _
        (ByVal pSecurityDescriptor As Long, _
        ByVal controlBitsOfInterest As Long, _
        ByVal controlBitsToSet As Long) As Long
        
Private Declare Function EqualSid Lib "advapi32.dll" _
        (ByVal pSid1 As Long, ByVal pSid2 As Long) As Long
Private Declare Function AddAce Lib "advapi32.dll" (ByVal pAcl As Long, _
        ByVal dwAceRevision As Long, ByVal dwStartingAceIndex As Long, _
        ByVal pAceList As Long, ByVal nAceListLength As Long) As Long

Private Declare Function AllocateAndInitializeSid Lib "advapi32.dll" _
        (pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, _
         ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, _
         ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, _
         ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, _
         ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, _
         ByVal nSubAuthority7 As Long, lpPSid As Long) As Long
Private Declare Sub FreeSid Lib "advapi32.dll" (ByVal pSid As Long)
   
' APIs for modifying DACL of a kernel object
Private Declare Function GetKernelObjectSecurity Lib "advapi32.dll" _
    (ByVal hObject As Long, _
    ByVal RequestedInformation As Long, _
    ByVal pSecurityDescriptor As Long, _
    ByVal nLength As Long, _
    lpnLengthNeeded As Long) As Long
Private Declare Function SetKernelObjectSecurity Lib "advapi32.dll" _
    (ByVal hObject As Long, _
    ByVal SecurityInformation As Long, _
    ByVal pSecurityDescriptor As Long) As Long
      
Private Declare Function CreateMutex Lib "kernel32.dll" _
    Alias "CreateMutexA" ( _
    lpMutexAttributes As SECURITY_ATTRIBUTES, _
    bInitialOwner As Long, _
    ByVal lpName As String) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" _
    (ByVal hObject As Long) As Long

Private Declare Function CreateFile Lib "kernel32.dll" _
    Alias "CreateFileA" (ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long

' APIs for modifying DACL of a user object like a windowstation or desktop
Private Declare Function GetUserObjectSecurity Lib "user32.dll" _
    (ByVal hObject As Long, _
    RequestedInformation As Long, _
    ByVal pSecurityDescriptor As Long, _
    ByVal nLength As Long, _
    lpnLengthNeeded As Long) As Long
Private Declare Function SetUserObjectSecurity Lib "user32.dll" _
    (ByVal hObject As Long, _
    SecurityInformation As Long, _
    ByVal pSecurityDescriptor As Long) As Long
Private Declare Function OpenDesktop Lib "user32.dll" Alias "OpenDesktopA" _
    (ByVal lpszDesktop As String, ByVal dwFlags As Long, _
    ByVal fInherit As Long, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseDesktop Lib "user32.dll" _
    (ByVal hDesktop As Long) As Long
Private Declare Function OpenWindowStation Lib "user32.dll" Alias _
    "OpenWindowStationA" _
    (ByVal lpszWindowStation As String, ByVal fInherit As Long, _
    ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseWindowStation Lib "user32.dll" _
    (ByVal hWindowStation As Long) As Long
Private Declare Function GetProcessWindowStation Lib "user32.dll" () As Long
Private Declare Function GetThreadDesktop Lib "user32.dll" _
    (ByVal dwThreadId As Long) As Long
Private Declare Function GetCurrentThread Lib "kernel32.dll" () As Long

' APIs for modifying DACL of a registry key
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
    Alias "RegOpenKeyExA" _
    (ByVal hKey As Long, _
    ByVal lpSubKey As String, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
    (ByVal hKey As Long) As Long
Private Declare Function RegGetKeySecurity Lib "advapi32.dll" _
    (ByVal hKey As Long, _
    ByVal SecurityInformation As Long, _
    ByVal pSecurityDescriptor As Long, _
    lpcbSecurityDescriptor As Long) As Long
Private Declare Function RegSetKeySecurity Lib "advapi32.dll" _
    (ByVal hKey As Long, _
    ByVal SecurityInformation As Long, _
    ByVal pSecurityDescriptor As Long) As Long
         
' APIs for modifying DACL of a file share
Private Declare Function NetShareGetInfo Lib "netapi32.dll" _
    (strServerName As Any, strShareName As Any, _
    ByVal dwLevel As Long, pBuffer As Long) As Long
Private Declare Function NetShareSetInfo Lib "netapi32.dll" _
    (strServerName As Any, strShareName As Any, _
    ByVal dwLevel As Long, ByVal pBuffer As Long, _
    ByVal parm_err As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" _
    (ByVal Buffer As Long) As Long
    
' APIs for modifying DACL of a Printer
Private Declare Function OpenPrinter Lib "winspool.drv" _
    Alias "OpenPrinterA" _
    (ByVal pPrinterName As String, _
    phPrinter As Long, _
    pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function SetPrinter Lib "winspool.drv" _
    Alias "SetPrinterA" _
    (ByVal hPrinter As Long, _
    ByVal Level As Long, _
    ByVal pPrinter As Long, _
    ByVal Command As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" _
    Alias "GetPrinterA" _
    (ByVal hPrinter As Long, _
    ByVal Level As Long, _
    ByVal pPrinter As Long, _
    ByVal cbBuf As Long, _
    pcbNeeded As Long) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" _
    (ByVal hPrinter As Long) As Long
    
' Version Checking APIs
Private Declare Function GetVersionExA Lib "kernel32.dll" _
    (lpVersionInformation As OSVERSIONINFO) As Integer
         
' Sample Function to demonstrate how a NEW security desciptor can be created
Private Sub CreateObjectSecurityDescriptor()

    Dim Accounts(0 To 1) As AccountPerm
    Dim fResult As Long
    
    Dim secAttr As SECURITY_ATTRIBUTES
    Dim hMutex As Long
    Dim sdInfo As SDMemInfo
    
    On Error GoTo Cleanup
    
    ' Set up the account permissions that need to be created as an array
    Accounts(0).AccountName = "User1"
    Accounts(0).AccessMask = GENERIC_ALL
    Accounts(0).AceFlags = CONTAINER_INHERIT_ACE Or OBJECT_INHERIT_ACE
    Accounts(0).AceType = ACCESS_DENIED_ACE_TYPE
    Accounts(0).pSid = 0
    Accounts(0).SidPassedByCaller = False
    
    Accounts(1).AccountName = "Group1"
    Accounts(1).AccessMask = GENERIC_ALL
    Accounts(1).AceFlags = 0
    Accounts(1).AceType = ACCESS_ALLOWED_ACE_TYPE
    Accounts(1).pSid = 0
    Accounts(1).SidPassedByCaller = False
           
    fResult = AddSecurityDescriptor(0, Accounts(), sdInfo)
    If fResult = 0 Then
        MsgBox "Unable to create Security Descriptor"
        Err.Raise 0
    End If
    
    ' Example of using the created security descriptor in a
    ' kernel/user object creation
    secAttr.Length = Len(secAttr)
    secAttr.InheritHandle = 0
    secAttr.SecurityDescriptor = sdInfo.pSD
    
    hMutex = CreateMutex(secAttr, 0, "TestMutex")
    If hMutex = 0 Then
        MsgBox "Unable to create mutex"
        Err.Raise 0
    End If
        
Cleanup:
    If (hMutex <> 0) Then CloseHandle (hMutex)
    
    'Free the memory allocated in CreateSecurityDescriptor
    If (sdInfo.pSD <> 0) Then LocalFree sdInfo.pSD
    sdInfo.pSD = 0
    If (sdInfo.pAcl <> 0) Then LocalFree sdInfo.pAcl
    sdInfo.pAcl = 0

End Sub

Private Function IsEqual(Accounts() As AccountPerm, pSid As Long) As Boolean
    Dim nEntries As Long
    Dim nIndex As Long
    
    ' Check if the supplied SID pSid matches with one of the
    ' new SIDs specified in Accounts()
    nEntries = UBound(Accounts)
    For nIndex = 0 To nEntries
        If (EqualSid(Accounts(nIndex).pSid, pSid)) Then
            IsEqual = True
            Exit Function
        End If
    Next
    IsEqual = False
End Function

Private Function ConstructAndAddAce( _
        ByVal pNewACL As Long, _
        ByVal AceType As Byte, _
        ByVal AceFlags As Byte, _
        ByVal AccessMask As Long, _
        ByVal pSid As Long) As Long
        Dim fResult As Long
    
    Dim dwNewACESize As Long
    Dim dwSidLen As Long
    Dim tempAce As ACE
    Dim pACE As Long

    fResult = 0
    On Error GoTo Label1
    
    ' Find the length of SID and size of new ACE to be added
    dwSidLen = GetLengthSid(pSid)
    dwNewACESize = Len(tempAce) + dwSidLen - 4
    
    ' Allocate memory for the new ACE
    pACE = LocalAlloc(LPTR, dwNewACESize)
    If pACE = 0 Then Err.Raise 0
    
    ' Set up the ACE structure in VB variable
    tempAce.Header.AceType = AceType
    tempAce.Header.AceFlags = AceFlags
    tempAce.Header.AceSize = dwNewACESize
    tempAce.Mask = AccessMask
    
    ' Copy the VB variable contents and the SID to the
    ' the ACE allocated
    CopyMemory ByVal pACE, VarPtr(tempAce), LenB(tempAce)
    CopyMemory ByVal pACE + 8, pSid, dwSidLen
    
    ' Add the new ACE to the new ACL
    fResult = AddAce(pNewACL, ACL_REVISION, _
                MAXDWORD, _
                pACE, _
                dwNewACESize)
    LocalFree pACE
Label1:
    ConstructAndAddAce = fResult
End Function
    
Private Function AddSecurityDescriptor(ByVal pOldSD As Long, _
                                        Accounts() As AccountPerm, _
                                        sdInfo As SDMemInfo) As Long

    Dim pNewACL As Long
    Dim dwNewACLSize As Long
    Dim dwTotalDACLSize As Long
    Dim szDomainName As String
    Dim cbDomainName As Long
    Dim nSidSize As Long
    Dim I As Long, n As Long
    Dim eUse As Long
    Dim fReturn As Long
    Dim fResult As Long
    Dim tempACL As ACL
    Dim tempAce As ACE
    Dim Ptr As Long
    Dim dwNumOfAccounts As Long
    Dim pSD As Long
    Dim AceIndex As Long
    Dim lDaclPresent As Long
    Dim lDaclDefaulted As Long
    Dim sACLInfo As ACL_SIZE_INFORMATION
    Dim pAcl As Long
    Dim osinfo As OSVERSIONINFO
    Dim w2kOrAbove As Boolean
    
    On Error GoTo ExitLabel
    
    ' Determine if system is Windows 2000 or above
    osinfo.dwOSVersionInfoSize = Len(osinfo)
    osinfo.szCSDVersion = Space$(128)
    GetVersionExA osinfo
    w2kOrAbove = _
        (osinfo.dwPlatformId = VER_PLATFORM_WIN32_NT And _
         osinfo.dwMajorVersion >= 5)

    ' Intialize some of the variables
    fReturn = 0
    sdInfo.pAcl = 0
    sdInfo.pSD = 0
    
    dwNumOfAccounts = UBound(Accounts)
    
    ' Allocate memory for a new Security Descriptor
    pSD = LocalAlloc(LPTR, SECURITY_DESCRIPTOR_MIN_LENGTH)
    If pSD = 0 Then Err.Raise 0
    sdInfo.pSD = pSD
    
    ' Initialize the new Security Descriptor
    fResult = InitializeSecurityDescriptor(pSD, SECURITY_DESCRIPTOR_REVISION)
    If fResult = 0 Then Err.Raise 0
     
    ' Get the existing ACL size
    lDaclPresent = 0
    pAcl = 0
    If (pOldSD) Then
        fResult = GetSecurityDescriptorDacl(pOldSD, lDaclPresent, _
              pAcl, lDaclDefaulted)
        If fResult = 0 Then Err.Raise 0
        
        If (lDaclPresent <> 0 And pAcl <> 0) Then
            fResult = GetAclInformation(pAcl, sACLInfo, Len(sACLInfo), 2&)
            If fResult = 0 Then Err.Raise 0
            dwTotalDACLSize = sACLInfo.AclBytesInUse
        Else
            dwTotalDACLSize = Len(tempACL)
        End If
    Else
        dwTotalDACLSize = Len(tempACL)
    End If
    
    ' Find the SIDs for each userName supplied in Accounts() array
    ' and compute the new ACL size needed.
    ' Call LookupAccountName only for the entries where the
    ' SID is not supplied by the caller.
    szDomainName = Space(256)
    For n = 0 To dwNumOfAccounts
        If (Accounts(n).pSid = 0) Then
            nSidSize = 0
            cbDomainName = 256
            
            ' Lookup the SID for this user
            ' First call is to find the buffer size required for SID
            fResult = LookupAccountName(0, Accounts(n).AccountName, 0, _
                                        nSidSize, szDomainName, _
                                        cbDomainName, eUse)
            Accounts(n).pSid = LocalAlloc(LPTR, nSidSize)
            If Accounts(n).pSid = 0 Then Err.Raise 0
        
            ' Get the Actual SID value in this second call
            fResult = LookupAccountName(0, Accounts(n).AccountName, _
                                        Accounts(n).pSid, _
                                        nSidSize, szDomainName, _
                                        cbDomainName, eUse)
            If fResult = 0 Then Err.Raise 0
        End If
        
        ' sizeof(DWORD) = 4
        dwNewACLSize = Len(tempAce) + GetLengthSid(Accounts(n).pSid) - 4
        dwTotalDACLSize = dwTotalDACLSize + dwNewACLSize
    Next
     
    ' Allocate memory for the new ACL
    pNewACL = LocalAlloc(LPTR, dwTotalDACLSize)
    If pNewACL = 0 Then Err.Raise 0
     
    sdInfo.pAcl = pNewACL
     
    ' Initialize the new ACL
    fResult = InitializeAcl(pNewACL, dwTotalDACLSize, ACL_REVISION)
    If fResult = 0 Then Err.Raise 0
     
    AceIndex = 0
    
    ' Add the new ACCESS DENIED ACEs first to the DACL
    For n = 0 To dwNumOfAccounts
        If (Accounts(n).AceType = ACCESS_DENIED_ACE_TYPE) Then
            fResult = ConstructAndAddAce(pNewACL, _
                        Accounts(n).AceType, _
                        Accounts(n).AceFlags, _
                        Accounts(n).AccessMask, _
                        Accounts(n).pSid)
            If fResult = 0 Then Err.Raise 0
            AceIndex = AceIndex + 1
        End If
    Next
     
    ' Copy all non-inherited ACEs from the existing DACL
    If (lDaclPresent <> 0 And pAcl <> 0 And sACLInfo.AceCount > 0) Then
        ' Get each ACE from the old DACL and add them into the new DACL.
        For I = 0 To (sACLInfo.AceCount - 1)
            ' Attempt to get the next ACE.
            fResult = GetAce(pAcl, I, Ptr)
            If (fResult = 0) Then Err.Raise 0
            
            CopyMemory tempAce, Ptr, LenB(tempAce)
            ' Exit this for loop, once the first INHERITED_ACE is found
            If ((tempAce.Header.AceFlags And INHERITED_ACE) = INHERITED_ACE) Then
                Exit For
            End If
            
            'Add the ACE to the new DACL if the SID is not in Accounts()
            If Not (IsEqual(Accounts(), Ptr + 8)) Then
                ' Now that you have the ACE, add it to the new ACL.
                fResult = AddAce(pNewACL, ACL_REVISION, _
                    MAXDWORD, Ptr, _
                    tempAce.Header.AceSize)
                If fResult = 0 Then Err.Raise 0
                AceIndex = AceIndex + 1
            End If
        Next I
    End If
    
    ' Add the new ACCESS ALLOWED ACEs next to the DACL
    For n = 0 To dwNumOfAccounts
        If (Accounts(n).AceType = ACCESS_ALLOWED_ACE_TYPE) Then
            fResult = ConstructAndAddAce(pNewACL, _
                        Accounts(n).AceType, _
                        Accounts(n).AceFlags, _
                        Accounts(n).AccessMask, _
                        Accounts(n).pSid)
            If fResult = 0 Then Err.Raise 0
            AceIndex = AceIndex + 1
        End If
    Next
     
    ' Copy now all inherited ACEs from the existing DACL, so that the
    ' new DACL will be in the Windows 2000 preferred order
    If (lDaclPresent <> 0 And pAcl <> 0 And sACLInfo.AceCount > 0) Then
        ' Get each INHERITED_ACE from the old ACL and
        ' add them into the new ACL.
        For I = I To (sACLInfo.AceCount - 1)
            ' Attempt to get the next ACE.
            fResult = GetAce(pAcl, I, Ptr)
            If (fResult = 0) Then Err.Raise 0
            
            CopyMemory tempAce, Ptr, LenB(tempAce)
            ' Add it to the new ACL.
            fResult = AddAce(pNewACL, ACL_REVISION, _
                    MAXDWORD, Ptr, _
                    tempAce.Header.AceSize)
            If fResult = 0 Then Err.Raise 0
            AceIndex = AceIndex + 1
        Next I
    End If
     
    If w2kOrAbove And pOldSD <> 0 Then
        Dim controlFlag As Long
        Dim dwRevision As Long
        Dim controlBitsOfInterest As Long
        Dim controlBitsToSet As Long
        
        fResult = GetSecurityDescriptorControl(pOldSD, _
                    controlFlag, dwRevision)
        If (fResult <> 0) Then
            controlBitsOfInterest = 0
            controlBitsToSet = 0
            If ((controlFlag And SE_DACL_AUTO_INHERITED) = _
                SE_DACL_AUTO_INHERITED) Then
                controlBitsOfInterest = _
                    SE_DACL_AUTO_INHERIT_REQ Or _
                    SE_DACL_AUTO_INHERITED
                controlBitsToSet = controlBitsOfInterest
            ElseIf ((controlFlag And SE_DACL_PROTECTED) = _
                SE_DACL_PROTECTED) Then
                controlBitsOfInterest = _
                    SE_DACL_PROTECTED
                controlBitsToSet = controlBitsOfInterest
            End If
            If controlBitsToSet <> 0 Then
                fResult = SetSecurityDescriptorControl(pSD, _
                            controlBitsOfInterest, _
                            controlBitsToSet)
                If fResult = 0 Then Err.Raise 0
            End If
        End If
    End If
    
    ' Add the new DACL to the new Security Descriptor
    fResult = SetSecurityDescriptorDacl(pSD, 1, pNewACL, 0)
    If fResult = 0 Then Err.Raise 0
     
    fReturn = 1
     
ExitLabel:
    ' Make sure we clean up
    For n = 0 To dwNumOfAccounts
        ' Free only the SIDs that has been allocated in this function
        If Accounts(n).pSid <> 0 And _
            Not (Accounts(n).SidPassedByCaller) Then
                LocalFree (Accounts(n).pSid)
                Accounts(n).pSid = 0
        End If
    Next
    ' If any of the functions failed, free new SD, and new ACL
    If fReturn = 0 Then
        If (sdInfo.pSD <> 0) Then LocalFree sdInfo.pSD
        sdInfo.pSD = 0
        If (sdInfo.pAcl <> 0) Then LocalFree sdInfo.pAcl
        sdInfo.pAcl = 0
    End If
     
    AddSecurityDescriptor = fReturn
 
End Function

Public Function UpdatePermissionsOfKernelObject( _
    ByVal hObject As Long, Accounts() As AccountPerm) As Boolean

    Dim fResult As Long
    
    Dim sdInfo As SDMemInfo
    Dim oldSD As Long
    Dim nLengthNeeded As Long
    Dim bStatus As Boolean
    
    bStatus = False
    On Error GoTo Cleanup
    
    sdInfo.pAcl = 0
    sdInfo.pSD = 0
    
    nLengthNeeded = 0
    fResult = GetKernelObjectSecurity(hObject, _
                DACL_SECURITY_INFORMATION, 0, _
                nLengthNeeded, nLengthNeeded)
    ' This call will fail. On Return nLengthNeeded will be updated.
    ' Check for that below
    If nLengthNeeded = 0 Then
        MsgBox "GetKernelObjectSecurity failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If

    oldSD = LocalAlloc(LPTR, nLengthNeeded)
    If oldSD = 0 Then
        MsgBox "LocalAlloc failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If
    
    fResult = GetKernelObjectSecurity(hObject, _
                DACL_SECURITY_INFORMATION, oldSD, _
                nLengthNeeded, nLengthNeeded)
    If fResult = 0 Then
        MsgBox "GetKernelObjectSecurity failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If

    fResult = AddSecurityDescriptor(oldSD, Accounts(), sdInfo)
    If fResult = 0 Then
        MsgBox "Unable to create Security Descriptor"
        Err.Raise 0
    End If
    
    fResult = SetKernelObjectSecurity(hObject, _
                DACL_SECURITY_INFORMATION, sdInfo.pSD)
    If fResult = 0 Then
        MsgBox "SetKernelObjectSecurity failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If
        
    bStatus = True
Cleanup:
    'Free the memory allocated
    If (oldSD <> 0) Then LocalFree oldSD
    oldSD = 0
    If (sdInfo.pSD <> 0) Then LocalFree sdInfo.pSD
    sdInfo.pSD = 0
    If (sdInfo.pAcl <> 0) Then LocalFree sdInfo.pAcl
    sdInfo.pAcl = 0
    UpdatePermissionsOfKernelObject = bStatus
End Function

Public Function UpdatePermissionsOfRegistryKey( _
    ByVal hKey As Long, Accounts() As AccountPerm) As Boolean

    Dim fResult As Long
    
    Dim sdInfo As SDMemInfo
    Dim oldSD As Long
    Dim nLengthNeeded As Long
    Dim bStatus As Boolean
    
    bStatus = False
    On Error GoTo Cleanup
    
    sdInfo.pAcl = 0
    sdInfo.pSD = 0
    
    nLengthNeeded = 0
    fResult = RegGetKeySecurity(hKey, _
                DACL_SECURITY_INFORMATION, 0, _
                nLengthNeeded)
    ' This call will fail. On Return nLengthNeeded will be updated.
    ' Check for that below
    If nLengthNeeded = 0 Then
        MsgBox "RegGetKeySecurity failed with error code : " _
            & fResult
        Err.Raise 0
    End If

    oldSD = LocalAlloc(LPTR, nLengthNeeded)
    If oldSD = 0 Then
        MsgBox "LocalAlloc failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If
    
    fResult = RegGetKeySecurity(hKey, _
                DACL_SECURITY_INFORMATION, oldSD, _
                nLengthNeeded)
    If fResult <> ERROR_SUCCESS Then
        MsgBox "RegGetKeySecurity failed with error code : " _
            & fResult
        Err.Raise 0
    End If

    fResult = AddSecurityDescriptor(oldSD, Accounts(), sdInfo)
    If fResult = 0 Then
        MsgBox "Unable to create Security Descriptor"
        Err.Raise 0
    End If
    
    fResult = RegSetKeySecurity(hKey, _
                DACL_SECURITY_INFORMATION, sdInfo.pSD)
    If fResult <> ERROR_SUCCESS Then
        MsgBox "RegSetKeySecurity failed with error code : " _
            & fResult
        Err.Raise 0
    End If
        
    bStatus = True
    
Cleanup:
    'Free the memory allocated
    If (oldSD <> 0) Then LocalFree oldSD
    oldSD = 0
    If (sdInfo.pSD <> 0) Then LocalFree sdInfo.pSD
    sdInfo.pSD = 0
    If (sdInfo.pAcl <> 0) Then LocalFree sdInfo.pAcl
    sdInfo.pAcl = 0
    UpdatePermissionsOfRegistryKey = bStatus
End Function

Public Function UpdatePermissionsOfShare(ShareName As String, _
        Accounts() As AccountPerm) As Boolean

    Dim sdInfo As SDMemInfo
    Dim oldSD As Long

    Dim fResult As Long

    Dim pServer() As Byte, pShare() As Byte
    Dim dwLevel As Long
    Dim shareInfo As SHARE_INFO_502
    Dim pBuffer As Long
    Dim bStatus As Boolean
    
    bStatus = False
    pBuffer = 0
    On Error GoTo Cleanup

    dwLevel = 502
    pShare = ShareName & vbNullChar 'Share name
    pServer = vbNullChar 'Server name
    ' Use level 502 to get share security descriptor information
    ' using NetShareGetInfo() API
    fResult = NetShareGetInfo(pServer(0), pShare(0), dwLevel, pBuffer)
    If fResult <> NERR_Success Then
        MsgBox "NetShareGetInfo failed with error code : " & _
            fResult & " for share " & ShareName
        Err.Raise 0
    End If

    CopyMemory shareInfo, pBuffer, Len(shareInfo)
    oldSD = shareInfo.shi502_security_descriptor

    fResult = AddSecurityDescriptor(oldSD, Accounts(), sdInfo)
    If fResult = 0 Then
        MsgBox "Unable to create Security Descriptor"
        Err.Raise 0
    End If

    shareInfo.shi502_security_descriptor = sdInfo.pSD
    CopyMemory ByVal pBuffer, VarPtr(shareInfo), Len(shareInfo)

    fResult = NetShareSetInfo(pServer(0), pShare(0), dwLevel, pBuffer, 0)
    If fResult <> NERR_Success Then
        MsgBox "NetShareSetInfo failed with error code : " & fResult & " for share " & "testshare"
    End If

    shareInfo.shi502_security_descriptor = oldSD
    CopyMemory ByVal pBuffer, VarPtr(shareInfo), Len(shareInfo)
    
    bStatus = True

Cleanup:
    'Free the memory allocated
    If (sdInfo.pSD <> 0) Then LocalFree sdInfo.pSD
    sdInfo.pSD = 0
    If (sdInfo.pAcl <> 0) Then LocalFree sdInfo.pAcl
    sdInfo.pAcl = 0
    If pBuffer <> 0 Then NetApiBufferFree (pBuffer)
    pBuffer = 0
    UpdatePermissionsOfShare = bStatus
End Function

Public Function UpdatePermissionsOfUserObject( _
    ByVal hObject As Long, Accounts() As AccountPerm) As Boolean

    Dim fResult As Long
    
    Dim sdInfo As SDMemInfo
    Dim oldSD As Long
    Dim nLengthNeeded As Long
    Dim bStatus As Boolean
    
    bStatus = False
    On Error GoTo Cleanup
    
    sdInfo.pAcl = 0
    sdInfo.pSD = 0
    
    nLengthNeeded = 0
    fResult = GetUserObjectSecurity(hObject, _
                DACL_SECURITY_INFORMATION, 0, _
                nLengthNeeded, nLengthNeeded)
    ' This call will fail. On Return nLengthNeeded will be updated.
    ' Check for that below
    If nLengthNeeded = 0 Then
        MsgBox "GetUserObjectSecurity failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If

    oldSD = LocalAlloc(LPTR, nLengthNeeded)
    If oldSD = 0 Then
        MsgBox "LocalAlloc failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If
    
    fResult = GetUserObjectSecurity(hObject, _
                DACL_SECURITY_INFORMATION, oldSD, _
                nLengthNeeded, nLengthNeeded)
    If fResult = 0 Then
        MsgBox "GetUserObjectSecurity failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If

    fResult = AddSecurityDescriptor(oldSD, Accounts(), sdInfo)
    If fResult = 0 Then
        MsgBox "Unable to create Security Descriptor"
        Err.Raise 0
    End If
    
    fResult = SetUserObjectSecurity(hObject, _
                DACL_SECURITY_INFORMATION, sdInfo.pSD)
    If fResult = 0 Then
        MsgBox "SetUserObjectSecurity failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If
        
    bStatus = True
Cleanup:
    'Free the memory allocated
    If (oldSD <> 0) Then LocalFree oldSD
    oldSD = 0
    If (sdInfo.pSD <> 0) Then LocalFree sdInfo.pSD
    sdInfo.pSD = 0
    If (sdInfo.pAcl <> 0) Then LocalFree sdInfo.pAcl
    sdInfo.pAcl = 0
    UpdatePermissionsOfUserObject = bStatus
End Function

Public Function UpdatePermissionsOfPrinter( _
    ByVal hObject As Long, Accounts() As AccountPerm) As Boolean

    Dim fResult As Long
    
    Dim sdInfo As SDMemInfo
    Dim printerInfo As PRINTER_INFO_3
    Dim oldSD As Long
    Dim nLengthNeeded As Long
    Dim bStatus As Boolean
    
    bStatus = False
    On Error GoTo Cleanup
    
    sdInfo.pAcl = 0
    sdInfo.pSD = 0
    
    nLengthNeeded = 0
    fResult = GetPrinter(hObject, _
                3, 0, _
                nLengthNeeded, nLengthNeeded)
    ' This call will fail. On Return nLengthNeeded will be updated.
    ' Check for that below
    If nLengthNeeded = 0 Then
        MsgBox "GetPrinter failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If

    oldSD = LocalAlloc(LPTR, nLengthNeeded)
    If oldSD = 0 Then
        MsgBox "LocalAlloc failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If
    
    fResult = GetPrinter(hObject, _
                3, oldSD, _
                nLengthNeeded, nLengthNeeded)
    If fResult = 0 Then
        MsgBox "GetPrinter failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If

    CopyMemory printerInfo, oldSD, 4
    fResult = AddSecurityDescriptor(printerInfo.pSecurityDescriptor, _
                Accounts(), sdInfo)
    If fResult = 0 Then
        MsgBox "Unable to create Security Descriptor"
        Err.Raise 0
    End If
    
    fResult = SetPrinter(hObject, _
                3, VarPtr(sdInfo.pSD), 0)
    If fResult = 0 Then
        MsgBox "SetPrinter failed with error code : " _
            & Err.LastDllError
        Err.Raise 0
    End If
        
    bStatus = True
Cleanup:
    'Free the memory allocated
    If (oldSD <> 0) Then LocalFree oldSD
    oldSD = 0
    If (sdInfo.pSD <> 0) Then LocalFree sdInfo.pSD
    sdInfo.pSD = 0
    If (sdInfo.pAcl <> 0) Then LocalFree sdInfo.pAcl
    sdInfo.pAcl = 0
    UpdatePermissionsOfPrinter = bStatus
End Function

Public Sub UpdatePermissionsOfFolder()

    Dim hFile As Long
    Dim FolderName As String
    Dim Accounts(0 To 3) As AccountPerm
    Dim n As Long
    Dim dwNumOfAccounts As Long
    Dim siaNtAuthority As SID_IDENTIFIER_AUTHORITY
      
    FolderName = "c:\temp\test"
    dwNumOfAccounts = UBound(Accounts)
    
    ' Set up the account permissions that need to be created as an array
    
    ' The following entry will allow permissions on the folder,
    ' as well as future subfolders/files
    Accounts(0).AccountName = ""
    Accounts(0).AccessMask = GENERIC_READ
    Accounts(0).AceFlags = CONTAINER_INHERIT_ACE Or OBJECT_INHERIT_ACE
    Accounts(0).AceType = ACCESS_ALLOWED_ACE_TYPE
    
    ' Construct SID for Everyone "Universal well-known SID"
    siaNtAuthority.Value(5) = SECURITY_WORLD_SID_AUTHORITY
    If AllocateAndInitializeSid(siaNtAuthority, 1, _
          SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, _
          Accounts(0).pSid) = 0 Then
        MsgBox "AllocateAndInitializeSid failed with error code : " _
            & Err.LastDllError
        Exit Sub
    End If
    'If the caller initializes SID, set SidPassedByCaller member to True
    Accounts(0).SidPassedByCaller = True
    
    ' The following entry will allow permissions on the folder
    Accounts(1).AccountName = "User1"
    Accounts(1).AccessMask = FILE_GENERIC_READ Or _
                                FILE_GENERIC_WRITE Or _
                                    FILE_GENERIC_EXECUTE
    Accounts(1).AceFlags = 0
    Accounts(1).AceType = ACCESS_ALLOWED_ACE_TYPE
    Accounts(1).pSid = 0
    Accounts(1).SidPassedByCaller = False
    
    ' The following entry will deny permissions on future files
    Accounts(2).AccountName = "User2"
    Accounts(2).AccessMask = FILE_ALL_ACCESS
    Accounts(2).AceFlags = OBJECT_INHERIT_ACE Or INHERIT_ONLY_ACE
    Accounts(2).AceType = ACCESS_DENIED_ACE_TYPE
    Accounts(2).pSid = 0
    Accounts(2).SidPassedByCaller = False
           
    ' The following entry will allow permissions on future subfolders
    Accounts(3).AccountName = "User3"
    Accounts(3).AccessMask = FILE_GENERIC_READ Or FILE_GENERIC_EXECUTE
    Accounts(3).AceFlags = CONTAINER_INHERIT_ACE Or INHERIT_ONLY_ACE
    Accounts(3).AceType = ACCESS_ALLOWED_ACE_TYPE
    Accounts(3).pSid = 0
    Accounts(3).SidPassedByCaller = False
    
    hFile = CreateFile(FolderName, _
        READ_CONTROL Or WRITE_DAC, _
        0, 0, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0)
    If (hFile = INVALID_HANDLE_VALUE) Then
        MsgBox "CreateFile failed with error code : " & Err.LastDllError
    Else
        UpdatePermissionsOfKernelObject hFile, Accounts
        CloseHandle hFile
    End If

    ' Make sure we clean up
    For n = 0 To dwNumOfAccounts
        If Accounts(n).pSid <> 0 And Accounts(n).SidPassedByCaller Then
            FreeSid (Accounts(n).pSid)
            Accounts(n).pSid = 0
        End If
    Next
End Sub

Public Sub UpdatePermissionsOfHKLM()

    Dim hKey As Long
    Dim KeyName As String
    Dim Accounts(0 To 2) As AccountPerm
    Dim fResult As Long, n As Long
    Dim dwNumOfAccounts As Long
    Dim siaNtAuthority As SID_IDENTIFIER_AUTHORITY
      
    KeyName = "SOFTWARE\TEST"
    dwNumOfAccounts = UBound(Accounts)
    
    ' Set up the account permissions that need to be created as an array
    Accounts(0).AccountName = ""
    Accounts(0).AccessMask = GENERIC_READ
    Accounts(0).AceFlags = CONTAINER_INHERIT_ACE
    Accounts(0).AceType = ACCESS_ALLOWED_ACE_TYPE
    
    ' Construct SID for Everyone "Universal well-known SID"
    siaNtAuthority.Value(5) = SECURITY_WORLD_SID_AUTHORITY
    If AllocateAndInitializeSid(siaNtAuthority, 1, _
          SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, _
          Accounts(0).pSid) = 0 Then
        MsgBox "AllocateAndInitializeSid failed with error code : " _
            & Err.LastDllError
        Exit Sub
    End If
    'If the caller initializes SID, set SidPassedByCaller member to True
    Accounts(0).SidPassedByCaller = True
    
    ' The following entry will allow permissions on the specified key
    Accounts(1).AccountName = "User1"
    Accounts(1).AccessMask = GENERIC_READ Or _
                                GENERIC_WRITE Or _
                                    GENERIC_EXECUTE Or _
                                        DELETE
    Accounts(1).AceFlags = 0
    Accounts(1).AceType = ACCESS_ALLOWED_ACE_TYPE
    Accounts(1).pSid = 0
    Accounts(1).SidPassedByCaller = False
    
    ' The following entry will deny all permissions on future subkeys
    Accounts(2).AccountName = "User2"
    Accounts(2).AccessMask = GENERIC_ALL
    Accounts(2).AceFlags = CONTAINER_INHERIT_ACE Or INHERIT_ONLY_ACE
    Accounts(2).AceType = ACCESS_DENIED_ACE_TYPE
    Accounts(2).pSid = 0
    Accounts(2).SidPassedByCaller = False
           
    fResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
                KeyName, 0, _
                READ_CONTROL Or WRITE_DAC, hKey)
    If fResult <> ERROR_SUCCESS Then
        MsgBox "RegOpenKeyEx failed with error code : " & fResult
    Else
        UpdatePermissionsOfRegistryKey hKey, Accounts
        RegCloseKey hKey
    End If

    ' Make sure we clean up
    For n = 0 To dwNumOfAccounts
        If Accounts(n).pSid <> 0 And Accounts(n).SidPassedByCaller Then
            FreeSid (Accounts(n).pSid)
            Accounts(n).pSid = 0
        End If
    Next
End Sub

Public Sub UpdatePermissionsOfTestShare()

    Dim hKey As Long
    Dim ShareName As String
    Dim Accounts(0 To 2) As AccountPerm
    Dim n As Long
    Dim dwNumOfAccounts As Long
    Dim siaNtAuthority As SID_IDENTIFIER_AUTHORITY
      
    ShareName = "TestShare"
    dwNumOfAccounts = UBound(Accounts)
    
    ' Set up the account permissions that need to be created as an array
    Accounts(0).AccountName = ""
    Accounts(0).AccessMask = READ_CONTROL Or SYNCHRONIZE Or &HA9
    Accounts(0).AceFlags = 0
    Accounts(0).AceType = ACCESS_ALLOWED_ACE_TYPE
    
    ' Construct SID for Everyone "Universal well-known SID"
    siaNtAuthority.Value(5) = SECURITY_WORLD_SID_AUTHORITY
    If AllocateAndInitializeSid(siaNtAuthority, 1, _
          SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, _
          Accounts(0).pSid) = 0 Then
        MsgBox "AllocateAndInitializeSid failed with error code : " _
            & Err.LastDllError
        Exit Sub
    End If
    'If the caller initializes SID, set SidPassedByCaller member to True
    Accounts(0).SidPassedByCaller = True
    
    ' The following entry will allow Change permissions for User1
    Accounts(1).AccountName = "User1"
    Accounts(1).AccessMask = GENERIC_READ Or _
                                GENERIC_WRITE Or _
                                    GENERIC_EXECUTE Or _
                                        DELETE
    Accounts(1).AceFlags = 0
    Accounts(1).AceType = ACCESS_ALLOWED_ACE_TYPE
    Accounts(1).pSid = 0
    Accounts(1).SidPassedByCaller = False
    
    ' The following entry will deny all permissions for User2
    Accounts(2).AccountName = "User2"
    Accounts(2).AccessMask = GENERIC_ALL
    Accounts(2).AceFlags = 0
    Accounts(2).AceType = ACCESS_DENIED_ACE_TYPE
    Accounts(2).pSid = 0
    Accounts(2).SidPassedByCaller = False
           
    UpdatePermissionsOfShare ShareName, Accounts

    ' Make sure we clean up
    For n = 0 To dwNumOfAccounts
        If Accounts(n).pSid <> 0 And Accounts(n).SidPassedByCaller Then
            FreeSid (Accounts(n).pSid)
            Accounts(n).pSid = 0
        End If
    Next
End Sub

Public Sub UpdatePermissionsOfDesktop()

    Dim hWinsta As Long
    Dim hDesktop As Long
    Dim WinstaName As String
    Dim DesktopName As String
    Dim Accounts(0 To 0) As AccountPerm
    Dim n As Long
    Dim dwNumOfAccounts As Long
      
    WinstaName = "Winsta0"
    DesktopName = "Default"
    dwNumOfAccounts = UBound(Accounts)
    
    ' Set up the account permissions that need to be created as an array
    
    ' The following entry will allow permissions for User1
    Accounts(0).AccountName = "User1"
    Accounts(0).AccessMask = GENERIC_READ Or _
                                GENERIC_WRITE Or _
                                    GENERIC_EXECUTE
    Accounts(0).AceFlags = 0
    Accounts(0).AceType = ACCESS_ALLOWED_ACE_TYPE
    Accounts(0).pSid = 0
    Accounts(0).SidPassedByCaller = False
    
    hWinsta = OpenWindowStation(WinstaName, _
        0, READ_CONTROL Or WRITE_DAC)
    If (hWinsta = 0) Then
        MsgBox "OpenWindowStation failed with error code : " & Err.LastDllError
    Else
        UpdatePermissionsOfUserObject hWinsta, Accounts
        CloseWindowStation hWinsta
    End If
    
    hDesktop = OpenDesktop(DesktopName, _
        0, 0, READ_CONTROL Or WRITE_DAC)
    If (hDesktop = 0) Then
        MsgBox "OpenDesktop failed with error code : " & Err.LastDllError
    Else
        UpdatePermissionsOfUserObject hDesktop, Accounts
        CloseDesktop hDesktop
    End If

    ' Make sure we clean up
    For n = 0 To dwNumOfAccounts
        If Accounts(n).pSid <> 0 And Accounts(n).SidPassedByCaller Then
            FreeSid (Accounts(n).pSid)
            Accounts(n).pSid = 0
        End If
    Next
End Sub

Public Sub UpdatePermissionsOfTestPrinter()

    Dim hPrinter As Long
    Dim printerName As String
    Dim Accounts(0 To 0) As AccountPerm
    Dim fResult As Long, n As Long
    Dim dwNumOfAccounts As Long
    Dim printerDefaults As PRINTER_DEFAULTS
      
    printerName = "TestPrinter"
    dwNumOfAccounts = UBound(Accounts)
    
    ' Set up the account permissions that need to be created as an array
    
    ' The following entry will allow permissions for User1
    Accounts(0).AccountName = "User1"
    Accounts(0).AccessMask = GENERIC_READ Or _
                                GENERIC_WRITE Or _
                                    GENERIC_EXECUTE
    Accounts(0).AceFlags = 0
    Accounts(0).AceType = ACCESS_ALLOWED_ACE_TYPE
    Accounts(0).pSid = 0
    Accounts(0).SidPassedByCaller = False
    
    printerDefaults.DesiredAccess = READ_CONTROL Or WRITE_DAC
    printerDefaults.pDatatype = 0
    printerDefaults.pDevMode = 0
    fResult = OpenPrinter(printerName, hPrinter, printerDefaults)
    If (fResult = 0) Then
        MsgBox "OpenPrinter failed with error code : " & Err.LastDllError
    Else
        UpdatePermissionsOfPrinter hPrinter, Accounts
        ClosePrinter hPrinter
    End If

    ' Make sure we clean up
    For n = 0 To dwNumOfAccounts
        If Accounts(n).pSid <> 0 And Accounts(n).SidPassedByCaller Then
            FreeSid (Accounts(n).pSid)
            Accounts(n).pSid = 0
        End If
    Next
End Sub