Option Explicit
' ********************************************
' * © 2000 Сергей Мерзликин *
' ********************************************
' Константы, определяющие запрашиваемые права доступа
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
' Структуры, константы и функции
' для работы с правами доступа
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
' Структуры, константы и функции для определения версии ОС
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
' Константа и функция для определения, поддерживает ли
' файловая система права доступа
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 проверяет права доступа к указанному файлу.
' DesiredAccess - битовая маска запрошенных прав доступа
' Функция возвращает битовую маску, состоящую из тех битов
' запрошенной маски, которые соответствуют имеющимся правам.
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
' Проверяем тип ОС
If Not IsNT() Then
' Права не поддерживаются. Возвращаем -1.
CheckFileAccess = -1
Exit Function
End If
' Определяем, поддерживает ли файловая система права доступа
If Left$(Filename, 2) = "\\" Then
' Путь в формате UNC. Выделяем из него имя разделяемого ресурса
r = InStr(3, Filename, "\")
If r = 0 Then
Volume = Filename & "\"
Else
Volume = Left$(Filename, r)
End If
ElseIf Mid$(Filename, 2, 2) = ":\" Then
' В начале пути есть имя диска
Volume = Left$(Filename, 3)
'Else
' Если путь не указан, оставляем Volume пустым.
' Это даст информацию о текущем диске.
End If
' Получаем информацию о диске
GetVolumeInformation Volume, vbNullString, 0, ByVal 0&, _
ByVal 0&, FSFlags, vbNullString, 0
If (FSFlags And FS_PERSISTENT_ACLS) = 0 Then
' Права не поддерживаются. Возвращаем -1.
CheckFileAccess = -1
Exit Function
End If
' Определяем размер буфера
GetFileSecurity Filename, OWNER_SECURITY_INFORMATION _
Or GROUP_SECURITY_INFORMATION _
Or DACL_SECURITY_INFORMATION, 0, 0, SDSize
If Err.LastDllError <> 122 Then
' Права не поддерживаются. Возвращаем -1.
CheckFileAccess = -1
Exit Function
End If
If SDSize = 0 Then Exit Function
' Выделяем буфер
ReDim SecDesc(1 To SDSize)
' Вызываем функцию еще раз,
' чтобы получить Security Descriptor
If GetFileSecurity(Filename, OWNER_SECURITY_INFORMATION _
Or GROUP_SECURITY_INFORMATION _
Or DACL_SECURITY_INFORMATION, _
SecDesc(1), SDSize, SDSize) = 0 Then
' Ошибка. Выходим и возвращаем отсутствие доступа.
Exit Function
End If
' Добавляем потоку Impersonation Token
ImpersonateSelf SecurityImpersonation
' Открываем Token текущего потока
OpenThreadToken GetCurrentThread(), TOKEN_QUERY, 0, hToken
If hToken <> 0 Then
' Заполняем структуру GenericMask
GenMap.GenericRead = FILE_GENERIC_READ
GenMap.GenericWrite = FILE_GENERIC_WRITE
GenMap.GenericExecute = FILE_GENERIC_EXECUTE
GenMap.GenericAll = FILE_ALL_ACCESS
' Преобразуем общие права
' в специфические права файлового доступа
MapGenericMask DesiredAccess, GenMap
' Проверяем доступ
AccessCheck SecDesc(1), hToken, DesiredAccess, GenMap, _
PrivSet, Len(PrivSet), CheckFileAccess, r
CloseHandle hToken
End If
' Удаляем Impersonation Token
RevertToSelf
End Function
' *-----------------------------------------------------------------------*
' Функция IsNT() возвращает True, если программа работает
' под управлением ОС Windows NT или Windows 2000, и False
' в противном случае.
Private Function IsNT() As Boolean
Dim OSVer As OSVERSIONINFO
OSVer.dwOSVersionInfoSize = Len(OSVer)
GetVersionEx OSVer
IsNT = (OSVer.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
' *-----------------------------------------------------------------------*
Приведенный выше код можно скопировать прямо из браузера.
|
