?
Solved

How to check the permissions for a registry location for a particular user

Posted on 2003-03-20
5
Medium Priority
?
596 Views
Last Modified: 2010-05-18
Programatically can I check the permissions (Read, Full Control) for a given user for a particular registry key location (say HKEY_CLASSES_ROOT).

My input is:
1) Registry key location (say HKEY_CLASSES_ROOT).
2) User Name

Output desired is:
Permissions (Read, Full Control)


0
Comment
Question by:Shantanu
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
5 Comments
 
LVL 3

Accepted Solution

by:
Shaka913 earned 1000 total points
ID: 8173383
VB6 must use API's to accomplish this, the code is listed below this description.

In vb.net there are classes to handle this:

The RegistryPermission class, which is in the System.Security.Permission namespace, controls the ability to access registry variables. Registry variables should not be stored in memory locations where code without RegistryPermission can access them. Similarly, when granting permissions, grant the least privilege necessary to get the job done. For more information, see RegistryPermission and System.Security.Permissions.

Registry permission access values are defined by the RegistryPermissionAccess enumeration. For more information, see RegistryPermissionAccess. The following table details its members.

Value Description
AllAccess Create, read, and write access to registry variables.
Create Create access to registry variables.
NoAccess No access to registry variables.
Read Read access to registry variables.
Write Write access to registry variables.

Note   If you need some combination of permissions, such as permitting read and write access while denying create access, you can combine them with a bitwise Or operation, as in this example:
RegistryPermissionAccess.Write Or RegistryPermissionAccess.Read _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\TestApp"


Option Explicit

'Module level Variables
Public merkRootKey As eRegistryRootKeys
Public msKeyAdd As String
Public msUName As String
Public mekpAttrib As eKeyPerms
Public mlTotal As Long
Public mvParams As Variant
' Constants used within our API calls. Refer
win32api.txt file and msdn
Public Const GMEM_MOVEABLE = &H2
Public Const LMEM_FIXED = &H0
Public Const LMEM_ZEROINIT = &H40
Public Const LPTR = (LMEM_FIXED + LMEM_ZEROINIT)

'collection object to hold all the class objects
Public moAllData As Collection
'declaration of class object
Public moPath As lilRegistryPermissions.cKeyAddresses

Public moLogWriter As lilLogWriter.clsLogWriter

'Constants Registry Key Permissions refer win32api.txt
file for constants
Public Enum eKeyPerms
   GENERIC_READ = &H80000000
   GENERIC_ALL = &H10000000
   GENERIC_EXECUTE = &H20000000
   GENERIC_WRITE = &H40000000
End Enum

' The security API call constants. refer to
win32api.txt file
Public Const DACL_SECURITY_INFORMATION = &H4
Public Const SECURITY_DESCRIPTOR_REVISION = 1
Public Const SECURITY_DESCRIPTOR_MIN_LENGTH = 20
Public Const SD_SIZE = (65536 +
SECURITY_DESCRIPTOR_MIN_LENGTH)
Public Const ACL_REVISION2 = 2
Public Const ACL_REVISION = 2
Public Const MAXDWORD = &HFFFFFFFF

'Type of User 1-user and 2-Group refer win32api.txt
file for constants

Public Const SidTypeUser = 2
Public Const AclSizeInformation = 2

'The following are the inherit flags that go into the
AceFlags field of an Ace header. refer win32api.txt
file

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
Public Const DELETE = &H10000

'Constant to compare Error return value from the API
call
Const ERROR_SUCCESS = 0
Const ERROR_INSUFFICIENT_BUFFER = 122

'This constant is used to format the error message
returned from the api call
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

'enumarated values for the RootKeys in the Registry

Public Enum eRegistryRootKeys
  rkHKeyClassesRoot = &H80000000
  rkHKeyCurrentUser = &H80000001
  rkhkeylocalmachine = &H80000002
  rkHKeyUsers = &H80000003
End Enum

'Type declaration for Filetime used in RegQueryInfo
API Call
Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

' Structures used by our API calls.

'Type Declarations for ACE's
Type ACE_HEADER
   AceType As Byte
   AceFlags As Byte
   AceSize As Integer
End Type

Public Type ACCESS_DENIED_ACE
  Header As ACE_HEADER
  Mask As Long
  SidStart As Long
End Type

Type ACCESS_ALLOWED_ACE
   Header As ACE_HEADER
   Mask As Long
   SidStart As Long
End Type

Type ACL
   AclRevision As Byte
   Sbz1 As Byte
   AclSize As Integer
   AceCount As Integer
   Sbz2 As Integer
End Type

'Type Declaration for Knowing the size information of
total ACL List

Type ACL_SIZE_INFORMATION
   AceCount As Long
   AclBytesInUse As Long
   AclBytesFree As Long
End Type

'Type Declaration for pSecurity Descriptor used in
reggetkeysecurity and regsetkeysecurity

Type SECURITY_DESCRIPTOR
   Revision As Byte
   Sbz1 As Byte
   Control As Long
   Owner As Long
   Group As Long
   sACL As ACL
   Dacl As ACL
End Type

'for the opening a key the one of the following as to
be passed as authorized rights
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const KEY_QUERY_VALUE = &H1
Public Const STANDARD_RIGHTS_ALL = &H1F0000
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 SYNCHRONIZE = &H100000
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)
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))


' API calls used

'API Call used to get a computer name
Private Declare Function GetComputerName Lib
"kernel32" Alias _
   "GetComputerNameA" (ByVal lpBuffer As String, _
   nSize As Long) As Long

'API Call used to get a username
Private Declare Function GetUserName Lib
"advapi32.dll" Alias _
   "GetUserNameA" (ByVal lpBuffer As String, nSize As
Long) As Long

'API call used to get sid for usern or group
Private Declare Function LookupAccountName Lib
"advapi32.dll" Alias _
   "LookupAccountNameA" (lpSystemName As String, _
   ByVal lpAccountName As String, sid As Any, cbSid As
Long, _
   ByVal ReferencedDomainName As String, _
   cbReferencedDomainName As Long, peUse As Long) As
Long

'API call used to initizlize the security descriptor
for revision
Private Declare Function InitializeSecurityDescriptor
Lib "advapi32.dll" _
   (pSecurityDescriptor As SECURITY_DESCRIPTOR, _
   ByVal dwRevision As Long) As Long

'API call used to get dacl of securitydescriptor
Private Declare Function GetSecurityDescriptorDacl Lib
"advapi32.dll" _
   (pSecurityDescriptor As Byte, lpbDaclPresent As
Long, _
   pDacl As Long, lpbDaclDefaulted As Long) As Long

'API call used to get file security
Private Declare Function GetFileSecurityN Lib
"advapi32.dll" Alias _
   "GetFileSecurityA" (ByVal lpFileName As String, _
   ByVal RequestedInformation As Long, _
   ByVal pSecurityDescriptor As Long, ByVal nLength As
Long, _
   lpnLengthNeeded As Long) As Long

Private Declare Function GetFileSecurity Lib
"advapi32.dll" Alias _
   "GetFileSecurityA" (ByVal lpFileName As String, _
   ByVal RequestedInformation As Long, _
   pSecurityDescriptor As Byte, ByVal nLength As Long,
_
   lpnLengthNeeded As Long) As Long

'API Call used to GetACL Information
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 EqualSid Lib "advapi32.dll"
(pSid1 As Byte, ByVal pSid2 As Long) As Long

Private Declare Function GetLengthSid Lib
"advapi32.dll" (pSid As Any) As Long

Private Declare Function InitializeAcl Lib
"advapi32.dll" (pAcl As Byte, _
   ByVal nAclLength As Long, ByVal dwAclRevision As
Long) As Long

Private Declare Function GetAce Lib "advapi32.dll"
(ByVal pAcl As Long, _
   ByVal dwAceIndex As Long, pace As Any) 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

'API call used to check whether ace added is allowed
or not
Private Declare Function AddAccessAllowedAce Lib
"advapi32.dll" _
   (pAcl As Byte, ByVal dwAceRevision As Long, _
   ByVal AccessMask As Long, pSid As Byte) As Long

Private Declare Function AddAccessDeniedAce Lib
"advapi32.dll" _
  (pAcl As Byte, ByVal dwAceRevision As Long, _
   ByVal AccessMask As Long, pSid As Byte) As Long

'API call for updating new secruitydescriptor list
Private Declare Function SetSecurityDescriptorDacl Lib
"advapi32.dll" _
   (pSecurityDescriptor As SECURITY_DESCRIPTOR, _
   ByVal bDaclPresent As Long, pDacl As Byte, _
   ByVal bDaclDefaulted As Long) As Long

Private Declare Function SetFileSecurity Lib
"advapi32.dll" Alias _
   "SetFileSecurityA" (ByVal lpFileName As String, _
   ByVal SecurityInformation As Long, _
   pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long

'API call for memory pointers
Private Declare Sub CopyMemory Lib "kernel32" Alias
"RtlMoveMemory" _
   (hpvDest As Any, ByVal hpvSource As Long, ByVal
cbCopy As Long)

'API call used for getting secruitydescriptor list
Private Declare Function RegGetKeySecurity Lib
"advapi32.dll" _
  (ByVal hKey As Long, ByVal SecurityInformation As
Long, _
  pSecurityDescriptor As Any, lpcbSecurityDescriptor
As Long) As Long

'API call used for Upadating new securitydescriptor to
a key
Private Declare Function RegSetKeySecurity Lib
"advapi32.dll" _
(ByVal hKey As Long, ByVal SecurityInformation As
Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) _
As Long

'API call for opening Key
Private Declare Function RegOpenKeyEx _
Lib "advapi32.dll" _
Alias "RegOpenKeyExA" _
(ByVal lngHKey As Long, _
  ByVal lpSubKey As String, _
  ByVal ulOptions As Long, _
  ByVal samDesired As Long, _
  phkResult As Long) _
As Long

'API call used to close a key
Private Declare Function RegCloseKey _
Lib "advapi32.dll" _
(ByVal lngHKey As Long) _
As Long

'API call used to format error message
Declare Function FormatMessage Lib "kernel32" Alias
"FormatMessageA" _
(ByVal dwFlags As Long, lpSource As Any, ByVal
dwMessageId As Long, _
ByVal dwLanguageId As Long, ByVal lpBuffer As String,
_
ByVal nSize As Long, Arguments As Long) As Long
 
'API used to know how many sub keys are there a key
Private Declare Function RegQueryInfoKey _
Lib "advapi32.dll" _
Alias "RegQueryInfoKeyA" _
   (ByVal lngHKey As Long, _
   ByVal lpClass As String, _
   ByVal lpcbClass As Long, _
   ByVal lpReserved As Long, _
   lpcSubKeys As Long, _
   lpcbMaxSubKeyLen As Long, _
   ByVal lpcbMaxClassLen As Long, _
   lpcValues As Long, _
   lpcbMaxValueNameLen As Long, _
   ByVal lpcbMaxValueLen As Long, _
   ByVal lpcbSecurityDescriptor As Long, _
   lpftLastWriteTime As FILETIME) _
As Long
 
'API call used to know all the names of all the keys
under a key i.e enumaration of sub keys
Declare Function RegEnumKey Lib "advapi32.dll" Alias
"RegEnumKeyA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal
lpName As String, ByVal cbName As Long) _
As Long

Private Sub pSetKeyAccess(erkRootKey As
eRegistryRootKeys, lsSubKey As String, lsUserName As
String, lekpMask As eKeyPerms)


Dim llResult As Long                ' Result of
various API calls.
Dim liCnt As Integer                ' Used in looping.
Dim lbytUserSid(255) As Byte        ' This will
contain SID.
Dim lbytTemSid(255) As Byte         ' This will
contain the Sid of each ACE in the ACL .
Dim lsSystemName As String          ' Name of this
computer system.

Dim lsSystemNameLength As Long      ' Length of string
that contains
Dim llLengthUserName As Long        ' Max length of
user name.

Dim llUserSID As Long               ' Used to hold the
SID of the
                                    ' current
user/group.

Dim llTempSid As Long               ' Used to hold the
SID of each ACE in the ACL
Dim llUserSIDSize As Long           ' Size of the SID.
Dim lsDomainName As String * 255    ' Domain the user
belongs to.
Dim llDomainNameLength As Long      ' Length of domain
name needed.

Dim llSIDType As Long               ' The type of SID
info we are
                                    ' getting back.

Dim ltypsFileSD As SECURITY_DESCRIPTOR   ' SD of the
file we want.

Dim lbytSDBuf() As Byte             ' Buffer that
holds the security
                                    ' descriptor for
this file.

Dim llFileSDSize As Long            ' Size of the File
SD.
Dim llSizeNeeded As Long            ' Size needed for
SD for file.


Dim ltypsNewSD As SECURITY_DESCRIPTOR ' New security
descriptor.

Dim ltypsACL As ACL                 ' Used in grabbing
the DACL from
                                    ' the File SD.

Dim llDaclPresent As Long           ' Used in grabbing
the DACL from
                                    ' the File SD.

Dim llDaclDefaulted As Long         ' Used in grabbing
the DACL from
                                    ' the File SD.

Dim ltypsACLInfo As ACL_SIZE_INFORMATION  ' Used in
grabbing the ACL
                                          ' from the
File SD.

Dim llACLSize As Long               ' Size of the ACL
structure used
                                    ' to get the ACL
from the File SD.

Dim llPAcl As Long                  ' Current ACL for
this file.
Dim llNewACLSize As Long            ' Size of new ACL
to create.
Dim lbytNewACL() As Byte            ' Buffer to hold
new ACL.

Dim ltypsCurrentACE As ACCESS_ALLOWED_ACE    ' Current
ACE.
Dim llpCurrentAce As Long                    ' Our
current ACE.

Dim llnRecordNumber As Long         'It counts number
of ACE'S

Dim lllSdSize As Long               'size of security
descriptor
Dim lbytSecurityDescriptor() As Byte  'security
descriptor for getting list
Dim lllngRetVal As Long
Dim lllngHKey As Long
   
   
   lllSdSize = 0
   
   ' Get the SID of the user

   llResult = LookupAccountName(vbNullString,
lsUserName, _
      lbytUserSid(0), 255, lsDomainName,
llDomainNameLength, _
      llSIDType)

   ' Now set the lsDomainName string buffer to its
proper size before
   ' calling the API again.
   
   lsDomainName = Space(llDomainNameLength)

   ' Call the LookupAccountName again to get the
actual SID for user.
   
   llResult = LookupAccountName(vbNullString,
lsUserName, _
      lbytUserSid(0), 255, lsDomainName,
llDomainNameLength, _
      llSIDType)

   ' Return value of zero means the call to
LookupAccountName failed;
   ' test for this before you continue.
   If (llResult = ERROR_SUCCESS) Then
      pDisplayError llResult, "LookUpAccountName"
      GoTo ExitHere
   End If

   'open existing key
   llResult = RegOpenKeyEx(erkRootKey, lsSubKey, 0,
KEY_ALL_ACCESS, lllngHKey)
   
   If (llResult <> ERROR_SUCCESS) Then
     pDisplayError llResult, "RegOpenKeyEx"
     GoTo ExitHere
   End If
   
   ' You now have the SID for the user who is logged
on.
   ' The SID is of interest since it will get the
security descriptor
   ' for the file that the user is interested in.
   ' call the RegGetKeySecurity API to get the
Security Descriptor List
     
   ' initializing the buffer with a very low size
   
    ReDim lbytSecurityDescriptor(lllSdSize)
   
    'first call is basically only to find out the
required buffer size
       
    llResult = RegGetKeySecurity(lllngHKey, _
      DACL_SECURITY_INFORMATION,
lbytSecurityDescriptor(0), lllSdSize)
   
    If llResult = ERROR_INSUFFICIENT_BUFFER Then
      ' redimensioning the buffer and calling the
function again
      ' the lllSdSize returned the required size from
the previous call
      ReDim lbytSecurityDescriptor(lllSdSize)
      llResult = RegGetKeySecurity(lllngHKey, _
        DACL_SECURITY_INFORMATION,
lbytSecurityDescriptor(0), lllSdSize)
    End If
   
    ' display message error if not successful
   
    If llResult <> ERROR_SUCCESS Then
        pDisplayError llResult, "RegGetKeySecurity"
        GoTo ExitHere
    End If

   ' Call InitializeSecurityDescriptor to build a new
Security Descriptor
   llResult = InitializeSecurityDescriptor(ltypsNewSD,
_
      SECURITY_DESCRIPTOR_REVISION)

   ' A return code of zero means the call failed; test
for this before continuing.
   If (llResult = ERROR_SUCCESS) Then
      pDisplayError llResult,
"InitializeSecurityDescriptor"
      GoTo ExitHere
   End If

   ' You now have the user/group Security Description
and a new Security Descriptor
   ' that will replace the current one. Next, pull the
DACL from
   ' the SD. To do so, call the
GetSecurityDescriptorDacl API
   ' function.

   llResult =
GetSecurityDescriptorDacl(lbytSecurityDescriptor(0),
llDaclPresent, _
      llPAcl, llDaclDefaulted)

   ' A return code of zero means the call failed; test
for this
   ' before continuing.
   
   If (llResult = ERROR_SUCCESS) Then
      pDisplayError llResult,
"GetSecurityDescriptorDacl"
      GoTo ExitHere
   End If

   ' You have the file's SD, and want to now pull the
ACL from the
   ' SD. To do so, call the GetACLInformation API
function.
   ' See if ACL exists for this file before getting
the ACL
   ' information.
   
   If (llDaclPresent = False) Then
      pDisplayError llDaclPresent,
"GetSecurityDescriptorDacl"
      GoTo ExitHere
   End If

   ' Attempt to get the ACL from the file's Security
Descriptor.
   
   llResult = GetAclInformation(llPAcl, ltypsACLInfo,
Len(ltypsACLInfo), AclSizeInformation)

   ' A return code of zero means the call failed; test
for this
   ' before continuing.
   
   If (llResult = ERROR_SUCCESS) Then
      pDisplayError llResult, "GetAclInformation"
      GoTo ExitHere
   End If

   ' Now that you have the ACL information, compute
the new ACL size
   ' requirements.
   
   llNewACLSize = ltypsACLInfo.AclBytesInUse +
(Len(ltypsCurrentACE) + _
      GetLengthSid(lbytUserSid(0))) * 2 - 4

   ' Resize our new ACL buffer to its proper size.
   
   ReDim lbytNewACL(llNewACLSize)

   ' Use the InitializeAcl API function call to
initialize the new
   ' ACL.
   
   llResult = InitializeAcl(lbytNewACL(0),
llNewACLSize, ACL_REVISION)

   ' A return code of zero means the call failed; test
for this
   ' before continuing.
   
   If (llResult = ERROR_SUCCESS) Then
      pDisplayError llResult, "InitializeAcl"
      GoTo ExitHere
   End If

   ' If a DACL is present, copy it to a new DACL.
   
   If (llDaclPresent) Then

      ' Copy the ACEs from the file to the new ACL.
      If (ltypsACLInfo.AceCount > 0) Then

         ' Grab each ACE and stuff them into the new
ACL.
         llnRecordNumber = 0
         For liCnt = 0 To (ltypsACLInfo.AceCount - 1)

            ' Attempt to grab the next ACE.
            llResult = GetAce(llPAcl, liCnt,
llpCurrentAce)

            ' Make sure you have the current ACE under
question.
            If (llResult = ERROR_SUCCESS) Then
               pDisplayError llResult, "GetAce"
               GoTo ExitHere
            End If

            ' You have a pointer to the ACE. Place it
            ' into a structure, so you can get at its
size.
             
             CopyMemory ltypsCurrentACE,
llpCurrentAce, LenB(ltypsCurrentACE)
           
            'Skip adding the ACE to the ACL if this is
same usersid
           
            llTempSid = llpCurrentAce + 8
           
            If EqualSid(lbytUserSid(0), llTempSid) = 0
Then
                                 
                ' Now that you have the ACE, add it to
the new ACL.
               
                llResult =
AddAce(VarPtr(lbytNewACL(0)), ACL_REVISION, _
                  MAXDWORD, llpCurrentAce, _
                  ltypsCurrentACE.Header.AceSize)
               
                 ' Make sure you have the current ACE
under question.
                 If (llResult = ERROR_SUCCESS) Then
                   pDisplayError llResult, "AddAce"
                    GoTo ExitHere
                 End If
                 
                 llnRecordNumber = llnRecordNumber + 1
           
            End If
             
         Next liCnt

         ' You have now rebuilt a new ACL and want to
add it to
         ' the newly created DACL.
         
         llResult = AddAccessAllowedAce(lbytNewACL(0),
ACL_REVISION, _
            lekpMask, lbytUserSid(0))

         ' Make sure added the ACL to the DACL.
         
         If (llResult = ERROR_SUCCESS) Then
            pDisplayError llResult,
"AddAccessAllowedAce"
            GoTo ExitHere
         End If
       
         ' Set the Current Security Descriptor to the
new DACL.
         llResult =
SetSecurityDescriptorDacl(ltypsNewSD, 1, _
            lbytNewACL(0), 0)

         ' Make sure you set the SD to the new DACL.
         If (llResult = ERROR_SUCCESS) Then
            pDisplayError llResult,
"SetSecurityDescriptorDacl"
            GoTo ExitHere
         End If

         ' The final step is to add the Security
Descriptor
          'updating new SD to the key
         
          llResult = RegSetKeySecurity(lllngHKey,
DACL_SECURITY_INFORMATION, ltypsNewSD)
         
          If (llResult <> ERROR_SUCCESS) Then
            pDisplayError llResult,
"RegSetKeySecurity"
            RegCloseKey (lllngHKey)
            GoTo ExitHere
          End If
         
          'closing the key which is opened
          RegCloseKey (lllngHKey)
               
      End If

   End If


ExitHere:
   Exit Sub
   
End Sub

Private Sub pDisplayError(ByVal lldwError As Long,
lsRelatedApi As String)

'************************************************************************************
'Method:             pDisplayError
'************************************************************************************
'Created By:          Viswanth
'Created On:          19/06/01
'Description:         this procedure to Display API
Errors
'Input:               long-lldwError-Error Return
Value, string-lsRelatedApi-API Name
'Output:              None
'Dependencies:        None
'************************************************************************************
'History:

'************************************************************************************

Dim lsErrorMsg As String
Dim lsSysMsg As String
Dim llMsgSize As Long
   
   ' get the error's description
   
   If lldwError <> 0 Then
       llMsgSize = 1000
       lsSysMsg = Space(llMsgSize)
       
       llMsgSize =
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, _
         lldwError, 0, lsSysMsg, llMsgSize, ByVal 0&)
       ' function returns number of characters in
string; 0=function failed
       If llMsgSize = 0 Then
           lsSysMsg = "System error code: " &
Str$(lldwError)
       Else
           ' resizing the string for output
           lsSysMsg = Left$(lsSysMsg, llMsgSize)
       End If
   Else
       lsSysMsg = ""
   End If
   
   ' including additional information in the string
   
   lsErrorMsg = "ErrorCode: " & Str$(lldwError) &
"API: " & lsRelatedApi & "System error: " & lsSysMsg
   moLogWriter.LogEvent lsErrorMsg, etError
   
End Sub


Private Sub pRegistrySubKeys(lerkRootKey As
eRegistryRootKeys, lsstrKeyName As String, llPos As
Long)
 
'************************************************************************************
'Method:             pRegistrySubKeys
'************************************************************************************
'Created By:          Viswanth
'Created On:          19/06/01
'Description:         this procedure is used to find
number child keys for a parent key
'Input:               lerkRootKey-Registry Root Key,
string-lsstrkeyname-masterkey name,
long-llpos-position of ckeyaddress object
'Output:              None
'Dependencies:        None
'************************************************************************************
'History:

'************************************************************************************

Dim llngRetVal As Long
Dim lllngHKey As Long
Dim lllngKeyIndex As Long
Dim lsstrSubKeyName As String
Dim lllngSubkeyCount As Long
Dim lllngMaxKeyLen As Long
Dim ltypFT As FILETIME
 
  On Error GoTo ErrHandler:
 
  ' Open the key
  llngRetVal = RegOpenKeyEx(lerkRootKey, lsstrKeyName,
0, KEY_ALL_ACCESS, _
    lllngHKey)
 
  If llngRetVal = ERROR_SUCCESS Then
   
    'find the number of subkeys, and redim the return
string array
    llngRetVal = RegQueryInfoKey(lllngHKey,
vbNullString, 0, 0, lllngSubkeyCount, _
      lllngMaxKeyLen, 0, 0, 0, 0, 0, ltypFT)
   
    If ERROR_SUCCESS = llngRetVal Then
      If lllngSubkeyCount > 0 Then
        'set up the while loop
        lllngKeyIndex = 0
        ' Pad the string to the maximum length of a
sub key, plus 1 for null
        ' termination
        lllngMaxKeyLen = lllngMaxKeyLen + 1
        lsstrSubKeyName = Space$(lllngMaxKeyLen)
       
        Do While RegEnumKey(lllngHKey, lllngKeyIndex,
lsstrSubKeyName, lllngMaxKeyLen + 1) = 0
       
          ' Set the string array to the key name,
removing null termination
          Set moPath = Nothing
          Set moPath = New
lilRegistryPermissions.cKeyAddresses
          If InStr(1, lsstrSubKeyName, vbNullChar) > 0
Then
              moPath.Path = lsstrKeyName & "\" &
Left$(lsstrSubKeyName, InStr(1, lsstrSubKeyName, _
              vbNullChar) - 1)
              moPath.Recursion = False
              moAllData.Add moPath
          End If
         
          ' Increment the key index for the return
string array
          lllngKeyIndex = lllngKeyIndex + 1
       
        Loop
       
            'if there are more then zero sub keys for
a master then the recursion property will be set to
true
            If llPos <> 0 Then
               Set moPath = Nothing
               Set moPath = moAllData.Item(llPos)
               moPath.Recursion = True
            End If
       
      Else
            'if there are no sub keys for a master key
then then recursion property will be set to true
            If llPos <> 0 Then
               Set moPath = Nothing
               Set moPath = moAllData.Item(llPos)
               moPath.Recursion = True
            End If
     
      End If
    End If
   
    ' Close the key
    RegCloseKey (lllngHKey)
   
  End If
 
  'Recursive loop
  For mlTotal = 1 To moAllData.Count
      Set moPath = Nothing
      Set moPath = moAllData.Item(mlTotal)
      If moPath.Recursion = False Then
         Call pRegistrySubKeys(merkRootKey,
moPath.Path, mlTotal)
      End If
  Next
 

ExitHere:
  Exit Sub

ErrHandler:
  pDisplayError llngRetVal, "RegistrySubKeys"
  Resume ExitHere

End Sub

Sub Main()

'************************************************************************************
'Method:             Main Procedure
'************************************************************************************
'Created By:          Viswanth
'Created On:          19/06/01
'Description:         This Procedure is used to set
permissions
'Input:               variant - mvparams(0) -
RegistryRootkey,variant - mvparams(1) - KeyPath
                      'variant - mvparams(2) -
username, variant - mvparams(3) - permissions
'Output:              None
'Dependencies:        None
'************************************************************************************
'History:

'************************************************************************************

'(lerkRootKey As eRegistryRootKeys, lsSubKeyAddress As
String, lsUserName As String, lkplMask As eKeyPerms)

Dim llKeyVal As Long
Dim lllngCount As Long
Dim lsParameters As String

On Error GoTo ErrHandler:
     
   lsParameters = Command
   'lsParameters =
"rkHKeyLocalMachine,"\Software\Logical
Innovations","regtest",GENERIC_ALL"
   
   mvParams = Split(lsParameters, ",", ,
vbTextCompare)
   
'   lvParams(0) = "HKeyLocalMachine"
'   lvParams(1) = "SOFTWARE\Logical Innovations"
'   lvParams(2) = "regtest"
'   lvParams(3) = "ALL"
   
   Set moPath = New
lilRegistryPermissions.cKeyAddresses
   Set moAllData = New Collection
   Set moLogWriter = New lilLogWriter.clsLogWriter
   
   moLogWriter.LogToFile (App.Path &
"\lilLogWriter.txt")
   
   'checks whether root key is valid or not
   Select Case mvParams(0)
      Case "HKeyClassesRoot"
            merkRootKey = rkHKeyClassesRoot
      Case "HKeyCurrentUser"
            merkRootKey = rkHKeyCurrentUser
      Case "HKeyLocalMachine"
            merkRootKey = rkhkeylocalmachine
      Case "HKeyUsers"
            merkRootKey = rkHKeyUsers
      Case Else
         moLogWriter.LogEvent "Invalid Registry Root
Key", etError
         GoTo ExitHere
   End Select
   
   'checks whether keypath is valid or not
   If Len(Trim$(mvParams(1))) = 0 Then
      moLogWriter.LogEvent "Invalid Registry Key
Address", etError
      GoTo ExitHere
   End If
   
   'checks whether username is valid or not
   If Len(Trim$(mvParams(2))) = 0 Then
      moLogWriter.LogEvent "Invalid User/Group Name",
etError
      GoTo ExitHere
   End If
   
   'checks whethere permissions or valid
   Select Case UCase(mvParams(3))
      Case "READ"
         mekpAttrib = GENERIC_READ
      Case "ALL"
         mekpAttrib = GENERIC_ALL
      Case "EXECUTE"
         mekpAttrib = GENERIC_EXECUTE
      Case "WRITE"
         mekpAttrib = GENERIC_WRITE
      Case Else
         moLogWriter.LogEvent "Invalid Permissions",
etError
         GoTo ExitHere
   End Select
   
   msKeyAdd = mvParams(1)
   msUName = mvParams(2)
   
   'set the permissions for Master Key
   Call pSetKeyAccess(merkRootKey, msKeyAdd, msUName,
mekpAttrib)
   
   'Get all the subkeys under the master key
   Call pRegistrySubKeys(merkRootKey, msKeyAdd, 0)
   
   'set the permissons for all subkeys
   For lllngCount = 1 To moAllData.Count
      Set moPath = Nothing
      Set moPath = moAllData.Item(lllngCount)
      If moPath.Recursion = True Then
         Call pSetKeyAccess(merkRootKey, moPath.Path,
msUName, mekpAttrib)
         moLogWriter.LogEvent mvParams(0) & "\" &
moPath.Path & ", " & msUName & ", " & mvParams(3)
      End If
   Next
   
   moLogWriter.LogEvent mvParams(0) & "\" & msKeyAdd &
", " & msUName & ", " & mvParams(3)

ExitHere:
   Set moPath = Nothing
   Set moAllData = Nothing
   Set moLogWriter = Nothing
   Exit Sub
   
ErrHandler:
   If Err.Number = 9 Then
      moLogWriter.LogEvent "Invalid Parameters
Passed", etError, Err.Number
      Resume ExitHere
   Else
      moLogWriter.LogEvent Err.Description, etError
   End If

End Sub
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

class module code which is private in nature and acts
like collection


Option Explicit

Private msPath As String
Private mbRecur As Boolean

Implements lilAppInterface.IClassObject

Public Property Get Path() As String
   'get the path value
   Path = msPath
End Property

Public Property Let Path(ByVal lsStr As String)
   'set the path value
   msPath = lsStr
End Property

Public Property Get Recursion() As Boolean
   'get the recursion value
   Recursion = mbRecur
End Property

Public Property Let Recursion(ByVal lbRecur As
Boolean)
   'set the recusion value
   mbRecur = lbRecur
End Property

Private Property Get IClassObject_ClassCreatedBy() As
String
   ' Name of person who created the object
   IClassObject_ClassCreatedBy = CREATED_BY
End Property

Private Property Get IClassObject_ClassCreatedOn() As
String
   ' Date object created
   IClassObject_ClassCreatedOn = CREATED_ON
End Property

Private Property Get IClassObject_ClassDescription()
As String
   ' description of class
   IClassObject_ClassDescription = MODULE_DESC
End Property

Private Property Get IClassObject_ClassID() As String
   ' GUID of this object, once compliled and set to
binary compatibile
End Property

Private Property Get IClassObject_ClassInstancing() As
Integer
   ' Class instancing mode
   IClassObject_ClassInstancing = 1 ' MultiUse
End Property

Private Property Get IClassObject_ClassMajor() As
Integer
   ' major version number of the class
   IClassObject_ClassMajor = MODULE_MAJOR
End Property

Private Property Get IClassObject_ClassMinor() As
Integer
   ' minor version number of the class
   IClassObject_ClassMinor = MODULE_MINOR
End Property

Private Property Get IClassObject_ClassName() As
String
   ' Name of this class, use the MODULE_NAME constant
and the application product name
   IClassObject_ClassName = App.ProductName & "." &
MODULE_NAME
End Property

Private Property Get IClassObject_ClassRevision() As
Integer
   ' revision number of the class
   IClassObject_ClassRevision = MODULE_REVISION
End Property

Private Property Get IClassObject_ClassVersion() As
String
   ' string of the class version number
   IClassObject_ClassVersion = IClassObject_ClassMajor
& "." & IClassObject_ClassMinor & "." &
IClassObject_ClassRevision
End Property
0
 

Author Comment

by:Shantanu
ID: 8179455
Till this point its fine......

llResult = GetAclInformation(llPAcl, ltypsACLInfo, Len(ltypsACLInfo), AclSizeInformation)


Now After this I don't want to set any new permissions, I just want to check the existing permissions. So how can check that the given user has Read OR Full Control permissions??.

--Shantanu
0
 

Expert Comment

by:CleanupPing
ID: 8531940
Hi Shantanu,
This old question (QID 20557275) needs to be finalized -- accept an answer, split points, or get a refund.  Please see http://www.cityofangels.com/Experts/Closing.htm for information and options.
0
 
LVL 6

Expert Comment

by:GPrentice00
ID: 8957368
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area that this question is:

-->Accept Shaka913 's comments as answer

Please leave any comments here within the next seven days.

PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!

GPrentice00
EE Cleanup Volunteer
0
 
LVL 6

Expert Comment

by:GPrentice00
ID: 8957371
Shantanu

The constants you need to check against are in the enum created.  I hope you were able to determine that.
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses
Course of the Month13 days, 21 hours left to enroll

801 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question