Option Explicit
' ********************************************
' * © 2000 Sergey Merzlikin *
' ********************************************
' Desired access rights constants
Public Const MAXIMUM_ALLOWED As Long = &H2000000
Public Const DELETE As Long = &H10000
Public Const READ_CONTROL As Long = &H20000
Public Const WRITE_DAC As Long = &H40000
Public Const WRITE_OWNER As Long = &H80000
Public Const SYNCHRONIZE As Long = &H100000
Public Const STANDARD_RIGHTS_READ As Long = READ_CONTROL
Public Const STANDARD_RIGHTS_WRITE As Long = READ_CONTROL
Public Const STANDARD_RIGHTS_EXECUTE As Long = READ_CONTROL
Public Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Public Const FILE_READ_DATA As Long = &H1 ' file & pipe
Public Const FILE_LIST_DIRECTORY As Long = &H1 ' directory
Public Const FILE_ADD_FILE As Long = &H2 ' directory
Public Const FILE_WRITE_DATA As Long = &H2 ' file & pipe
Public Const FILE_CREATE_PIPE_INSTANCE As Long = &H4 ' named pipe
Public Const FILE_ADD_SUBDIRECTORY As Long = &H4 ' directory
Public Const FILE_APPEND_DATA As Long = &H4 ' file
Public Const FILE_READ_EA As Long = &H8 ' file & directory
Public Const FILE_READ_PROPERTIES As Long = FILE_READ_EA
Public Const FILE_WRITE_EA As Long = &H10 ' file & directory
Public Const FILE_WRITE_PROPERTIES As Long = FILE_WRITE_EA
Public Const FILE_EXECUTE As Long = &H20 ' file
Public Const FILE_TRAVERSE As Long = &H20 ' directory
Public Const FILE_DELETE_CHILD As Long = &H40 ' directory
Public Const FILE_READ_ATTRIBUTES As Long = &H80 ' all
Public Const FILE_WRITE_ATTRIBUTES As Long = &H100 ' all
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)
Public Const FILE_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED _
Or SYNCHRONIZE Or &H1FF&)
Public Const GENERIC_READ As Long = &H80000000
Public Const GENERIC_WRITE As Long = &H40000000
Public Const GENERIC_EXECUTE As Long = &H20000000
Public Const GENERIC_ALL As Long = &H10000000
' Types, constants and functions
' to work with access rights
Private Const OWNER_SECURITY_INFORMATION As Long = &H1
Private Const GROUP_SECURITY_INFORMATION As Long = &H2
Private Const DACL_SECURITY_INFORMATION As Long = &H4
Private Const TOKEN_QUERY As Long = 8
Private Const SecurityImpersonation As Integer = 3
Private Const ANYSIZE_ARRAY = 1
Private Type GENERIC_MAPPING
GenericRead As Long
GenericWrite As Long
GenericExecute As Long
GenericAll As Long
End Type
Private Type LUID
LowPart As Long
HighPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type PRIVILEGE_SET
PrivilegeCount As Long
Control As Long
Privilege(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
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
Private Declare Function AccessCheck Lib "advapi32.dll" _
(pSecurityDescriptor As Byte, ByVal ClientToken As Long, _
ByVal DesiredAccess As Long, GenericMapping As GENERIC_MAPPING, _
PrivilegeSet As PRIVILEGE_SET, PrivilegeSetLength As Long, _
GrantedAccess As Long, Status As Long) As Long
Private Declare Function ImpersonateSelf Lib "advapi32.dll" _
(ByVal ImpersonationLevel As Integer) As Long
Private Declare Function RevertToSelf Lib "advapi32.dll" () As Long
Private Declare Sub MapGenericMask Lib "advapi32.dll" (AccessMask As Long, _
GenericMapping As GENERIC_MAPPING)
Private Declare Function OpenThreadToken Lib "advapi32.dll" _
(ByVal ThreadHandle As Long, ByVal DesiredAccess As Long, _
ByVal OpenAsSelf As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
' Types, constants and functions for OS version detection
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 Const VER_PLATFORM_WIN32_NT As Long = 2
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
' Constant and function for detection of support
' of access rights by file system
Private Const FS_PERSISTENT_ACLS As Long = &H8
Private Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
' *-----------------------------------------------------------------------*
' CheckFileAccess function checks access rights to given file.
' DesiredAccess - bitmask of desired access rights.
' The function returns bitmask, which contains those bits of desired bitmask,
' which correspond with existing access rights.
Private Function CheckFileAccess(Filename As String, _
ByVal DesiredAccess As Long) As Long
Dim r As Long, SecDesc() As Byte, SDSize As Long, hToken As Long
Dim PrivSet As PRIVILEGE_SET, GenMap As GENERIC_MAPPING
Dim Volume As String, FSFlags As Long
' Checking OS type
If Not IsNT() Then
' Rights not supported. Returning -1.
CheckFileAccess = -1
Exit Function
End If
' Checking access rights support by file system
If Left$(Filename, 2) = "\\" Then
' Path in UNC format. Extracting share name from it
r = InStr(3, Filename, "\")
If r = 0 Then
Volume = Filename & "\"
Else
Volume = Left$(Filename, r)
End If
ElseIf Mid$(Filename, 2, 2) = ":\" Then
' Path begins with drive letter
Volume = Left$(Filename, 3)
'Else
' If path not set, we are leaving Volume blank.
' It retutns information about current drive.
End If
' Getting information about drive
GetVolumeInformation Volume, vbNullString, 0, ByVal 0&, _
ByVal 0&, FSFlags, vbNullString, 0
If (FSFlags And FS_PERSISTENT_ACLS) = 0 Then
' Rights not supported. Returning -1.
CheckFileAccess = -1
Exit Function
End If
' Determination of buffer size
GetFileSecurity Filename, OWNER_SECURITY_INFORMATION _
Or GROUP_SECURITY_INFORMATION _
Or DACL_SECURITY_INFORMATION, 0, 0, SDSize
If Err.LastDllError <> 122 Then
' Rights not supported. Returning -1.
CheckFileAccess = -1
Exit Function
End If
If SDSize = 0 Then Exit Function
' Buffer allocation
ReDim SecDesc(1 To SDSize)
' Once more call of function
' to obtain Security Descriptor
If GetFileSecurity(Filename, OWNER_SECURITY_INFORMATION _
Or GROUP_SECURITY_INFORMATION _
Or DACL_SECURITY_INFORMATION, _
SecDesc(1), SDSize, SDSize) = 0 Then
' Error. We must return no access rights.
Exit Function
End If
' Adding Impersonation Token for thread
ImpersonateSelf SecurityImpersonation
' Opening of Token of current thread
OpenThreadToken GetCurrentThread(), TOKEN_QUERY, 0, hToken
If hToken <> 0 Then
' Filling GenericMask type
GenMap.GenericRead = FILE_GENERIC_READ
GenMap.GenericWrite = FILE_GENERIC_WRITE
GenMap.GenericExecute = FILE_GENERIC_EXECUTE
GenMap.GenericAll = FILE_ALL_ACCESS
' Conversion of generic rights
' to specific file access rights
MapGenericMask DesiredAccess, GenMap
' Checking access
AccessCheck SecDesc(1), hToken, DesiredAccess, GenMap, _
PrivSet, Len(PrivSet), CheckFileAccess, r
CloseHandle hToken
End If
' Deleting Impersonation Token
RevertToSelf
End Function
' *-----------------------------------------------------------------------*
' IsNT() function returns True, if the program works
' in Windows NT or Windows 2000 operating system, and False
' otherwise.
Private Function IsNT() As Boolean
Dim OSVer As OSVERSIONINFO
OSVer.dwOSVersionInfoSize = Len(OSVer)
GetVersionEx OSVer
IsNT = (OSVer.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
' *-----------------------------------------------------------------------*
You may copy above source code directly from a browser.
|
