Private Declare Function InitializeAcl Lib "advapi32.dll" ( _
ByVal pAcl As Long, _
ByVal nAclLength As Long, _
ByVal dwAclRevision As Long) As Long
Private Type ACL
AclRevision As Byte
Sbz1 As Byte
AclSize As Integer
AceCount As Integer
Sbz2 As Integer
End Type
Private Declare Function AddAccessDeniedAce Lib "advapi32.dll" ( _
ByVal pAcl As Long, _
ByVal dwAceRevision As Long, _
ByVal AccessMask As Long, _
ByRef pSid As Any) As Long
Private Declare Function AddAccessAllowedAce Lib "advapi32.dll" ( _
ByVal pAcl As Long, _
ByVal dwAceRevision As Long, _
ByVal AccessMask As Long, _
ByRef pSid As Any) As Long
Private Enum SE_OBJECT_TYPE
SE_UNKNOWN_OBJECT_TYPE = 0
SE_FILE_OBJECT
SE_SERVICE
SE_PRINTER
SE_REGISTRY_KEY
SE_LMSHARE
SE_KERNEL_OBJECT
SE_WINDOW_OBJECT
SE_DS_OBJECT
SE_DS_OBJECT_ALL
SE_PROVIDER_DEFINED_OBJECT
SE_WMIGUID_OBJECT
End Enum
Private Declare Function SetSecurityInfo Lib "advapi32.dll" (ByVal Handle As Long, ByVal ObjectType As SE_OBJECT_TYPE, ByVal SecurityInfo As Long, ppsidOwner As Long, ppsidGroup As Long, ppDacl As Any, ppSacl As Any) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" ( _
ByVal hObject As Long) As Long
Private Declare Sub FreeSid Lib "advapi32.dll" ( _
ByRef pSid As Any)
Private Declare Function GetTokenInformation Lib "advapi32.dll" ( _
ByVal TokenHandle As Long, _
ByRef TokenInformationClass As Integer, _
ByRef TokenInformation As Any, _
ByVal TokenInformationLength As Long, _
ByRef ReturnLength As Long) As Long
Private Declare Function LocalAlloc Lib "kernel32.dll" ( _
ByVal wFlags As Long, _
ByVal wBytes As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" ( _
ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
ByRef TokenHandle As Long) As Long
Private Declare Function AllocateAndInitializeSid Lib "advapi32.dll" ( _
ByRef 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, _
ByRef lpPSid As Any) As Long
Private Type SID_IDENTIFIER_AUTHORITY
Value(6) As Byte
End Type
Private Const TOKEN_QUERY As Long = &H8
Private Const LMEM_FIXED As Long = &H0
Private Const LMEM_ZEROINIT As Long = &H40
Private Const LPTR As Long = (LMEM_FIXED + LMEM_ZEROINIT)
Private Const ACL_REVISION As Long = 2
Private Const DACL_SECURITY_INFORMATION As Long = &H4&
Private Const PROTECTED_DACL_SECURITY_INFORMATION As Long = (&H80000000)
Private Declare Function GetLastError Lib "kernel32.dll" () As Long
Private Type SID_AND_ATTRIBUTES
Sid As Long
Attributes As Long
End Type
Public Function DisableProcessAccess(ByVal hProcess As Long, ByVal dwAccessDenied As Long, ByVal dwAccessAllowed As Long) As Boolean
Dim sia As SID_IDENTIFIER_AUTHORITY
Dim pSid As Long 'psid
Dim bSuccess As Boolean
Dim buf(1 To &H400) As Byte
Dim buf1(1 To &H400) As Byte
Dim pTokenUser As Long 'pToken_User
Dim pAcl As Long 'pAcl
pAcl = VarPtr(buf(1))
Dim TokenInfo As Long
Dim hToken As Long
Dim dwRetLen As Long
Dim dw As Long
bSuccess = AllocateAndInitializeSid(sia, 1, 0, 0, 0, 0, 0, 0, 0, 0, ByVal VarPtr(pSid))
Debug.Print GetLastError
If (Not bSuccess) Then GoTo Cleanup
bSuccess = OpenProcessToken(hProcess, TOKEN_QUERY, ByVal VarPtr(hToken))
'Debug.Print GetLastError
If (Not bSuccess) Then GoTo Cleanup
bSuccess = InitializeAcl(pAcl, &H400, ACL_REVISION)
'Debug.Print GetLastError
If (Not bSuccess) Then GoTo Cleanup
bSuccess = AddAccessDeniedAce(pAcl, ACL_REVISION, dwAccessDenied, ByVal pSid)
'Debug.Print GetLastError
If (Not bSuccess) Then GoTo Cleanup
bSuccess = AddAccessAllowedAce(pAcl, ACL_REVISION, dwAccessAllowed, ByVal pSid)
'Debug.Print GetLastError
If (Not bSuccess) Then GoTo Cleanup
If (SetSecurityInfo(hProcess, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION Or PROTECTED_DACL_SECURITY_INFORMATION, ByVal 0, ByVal 0, ByVal pAcl, ByVal 0) = 0) Then bSuccess = True
Debug.Print GetLastError
Cleanup:
If (hProcess <> 0) Then CloseHandle (hProcess)
If (pSid <> 0) Then Call FreeSid(ByVal pSid)
DisableProcessAccess = bSuccess
End Function