tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板 [ツリー表示へ]   [Home]
一括表示(VB6.0)
タイトルファイルのアクセス権を判定する関数
記事No13572
投稿日: 2009/04/06(Mon) 11:15
投稿者はるちゃん
ファイルのアクセス権を判定する関数(Function )を作ったのですが、
フルコントロール(拒否)、変更(拒否)、読み取り(拒否)のときは
うまく動作するのですが、書き込み(拒否)のときは、読み取りはOKなので
判定をOKにしたいのですが、どのようにすれば取得できるでしょうか?
WINDOWS XP SP2 VB6 SP6 です、よろしくお願いします


Option Explicit

'■■ 定数宣言 ■■
Public Const GMEM_FIXED = &H0   ' 固定メモリ確保

'■■ API関数宣言 ■■
' メモリの確保
Declare Function GlobalAlloc Lib "kernel32" ( _
                            ByVal wFlags As Long, _
                            ByVal dwBytes As Long) As Long
' 確保したメモリの開放
Declare Function GlobalFree Lib "kernel32" ( _
                            ByVal hMem As Long) As Long

' メモリブロックの移動
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
                            pDest As Any, _
                            pSource As Any, _
                            ByVal dwLength As Long)

'■■ 定数宣言 ■■
Public Const ERROR_INSUFFICIENT_BUFFER = 122

Enum ACL_INFORMATION_CLASS
    AclRevisionInformation = 1      '// ACL revision information
    AclSizeInformation = 2          '// ACL size information
End Enum

' GetFileSecurity の RequestedInformation パラメータ
Enum SECURITY_INFORMATION
    OWNER_SECURITY_INFORMATION = &H1  ' 所有者
    GROUP_SECURITY_INFORMATION = &H2  ' アクセス権グループ
    DACL_SECURITY_INFORMATION = &H4   ' 任意のACL(アクセスの種類)
    SACL_SECURITY_INFORMATION = &H8   ' システムACL(アクセスの種類)
End Enum

' LookupAccountName,LookupAccountSid の peUse パラメータ
Enum SID_NAME_USE
    SidTypeUser             ' ユーザーアカウント
    SidTypeGroup            ' グローバルグループアカウント
    SidTypeDomain           ' ドメインアカウント
    SidTypeAlias            ' エイリアス
    SidTypeWellKnownGroup   ' 有名なグループアカウント(Everyoneなど)
    SidTypeDeletedAccount   ' 削除アカウント
    SidTypeInvalid          ' 無効なアカウント
    SidTypeUnknown          ' 不明
End Enum

'//
'//  The following are the predefined ace types that go into the AceType
'//  field of an Ace header.
'//

Public Const ACCESS_ALLOWED_ACE_TYPE = &H0  ' アクセス許可ACE
Public Const ACCESS_DENIED_ACE_TYPE = &H1   ' アクセス拒否ACE
Public Const SYSTEM_AUDIT_ACE_TYPE = &H2    ' 監査ACE
Public Const SYSTEM_ALARM_ACE_TYPE = &H3    ' 未サポート

'//
'//  The following are the inherit flags that go into the AceFlags field
'//  of an Ace header.
'//

Public Const OBJECT_INHERIT_ACE = &H1        ' プライマリオブジェクトに含まれた他のコンテナがACEを継承する
Public Const CONTAINER_INHERIT_ACE = &H2     ' プライマリオブジェクトに含まれたコンテナのみがACEを継承する
Public Const NO_PROPAGATE_INHERIT_ACE = &H4  ' OBJECT_INHERIT_ACE,CONTAINER_INHERIT_ACE が指定されている場合子オブジェクトにACEを引き継がない
Public Const INHERIT_ONLY_ACE = &H8          ' プライマリオブジェクトに含まれた他のコンテナのみがACEを継承する
Public Const VALID_INHERIT_FLAGS = &HF      '

'//  The following are the currently defined ACE flags that go into the
'//  AceFlags field of an ACE header.  Each ACE type has its own set of
'//  AceFlags.
'//
'//  SUCCESSFUL_ACCESS_ACE_FLAG - used only with system audit and alarm ACE
'//  types to indicate that a message is generated for successful accesses.
'//
'//  FAILED_ACCESS_ACE_FLAG - used only with system audit and alarm ACE types
'//  to indicate that a message is generated for failed accesses.
'//

'//
'//  SYSTEM_AUDIT and SYSTEM_ALARM AceFlags
'//
'//  These control the signaling of audit and alarms for success or failure.
'//

Public Const SUCCESSFUL_ACCESS_ACE_FLAG = &H40
Public Const FAILED_ACCESS_ACE_FLAG = &H80


'■■ 構造体宣言 ■■

Type ACL_SIZE_INFORMATION
    AceCount As Long        ' ACEの数
    AclBytesInUse As Long   ' 利用しているACLサイズ
    AclBytesFree As Long    ' ACLの空きサイズ
End Type

Type ACE_HEADER
    AceType As Byte         ' ACEタイプ
    AceFlags As Byte        ' ACEフラグ
    AceSize As Integer      ' ACEサイズ
End Type

'//
'//  We'll define the structure of the predefined ACE types.  Pictorally
'//  the structure of the predefined ACE's is as follows:
'//
'//       3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
'//       1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
'//      +---------------+-------+-------+---------------+---------------+
'//      |    AceFlags   | Resd  |Inherit|    AceSize    |     AceType   |
'//      +---------------+-------+-------+---------------+---------------+
'//      |                              Mask                             |
'//      +---------------------------------------------------------------+
'//      |                                                               |
'//      +                                                               +
'//      |                                                               |
'//      +                              Sid                              +
'//      |                                                               |
'//      +                                                               +
'//      |                                                               |
'//      +---------------------------------------------------------------+
'//
'//  Mask is the access mask associated with the ACE.  This is either the
'//  access allowed, access denied, audit, or alarm mask.
'//
'//  Sid is the Sid associated with the ACE.
'//

'//  The following are the four predefined ACE types.

'//  Examine the AceType field in the Header to determine
'//  which structure is appropriate to use for casting.

' 以下の構造体は、ACE_HEADER構造体のAceTypeメンバの値により利用する構造体
' を特定しますが、構造体が同じ構成の為、サンプルでは全てACCESS_ALLOWED_ACE
' 構造体を代用しています。

Type ACCESS_ALLOWED_ACE
    Header As ACE_HEADER    ' ACE_HEADER 構造体
    Mask As Long            ' アクセスマスク
    SidStart As Long        ' SIDの開始ポインタ
End Type

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

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

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

'■■ API関数宣言 ■■
'------------------------------------------------------
' ファイルのセキュリティ情報の取得
'------------------------------------------------------
' [I] lpFileName           : 対象となるファイル名
' [I] RequestedInformation : 取得するセキュリティ情報のタイプ(SECURITY_INFORMATIONの組み合わせ)
' [O] pSecurityDescriptor  : 取得したSID
' [I] nLength              : pSecurityDescriptorのサイズ
' [O] lpnLengthNeeded      : バッファ必要サイズ
'
'     戻り値                : 0以外 = 成功
'                           : 0     = 失敗
'
Declare Function GetFileSecurity Lib "advapi32.dll" Alias "GetFileSecurityA" ( _
                            ByVal lpFileName As String, _
                            ByVal RequestedInformation As SECURITY_INFORMATION, _
                            pSecurityDescriptor As Long, _
                            ByVal nLength As Long, _
                            lpnLengthNeeded As Long) As Long

'------------------------------------------------------
' セキュリティ情報より所有者SID取得
'------------------------------------------------------
' [I] pSecurityDescriptor : SD(セキュリティ記述子)
' [O] pOwner              : 所有者SID
' [O] lpbOwnerDefaulted   : デフォルト所有者の場合(True)
'
'     戻り値              : 0以外 = 成功
'                         : 0     = 失敗
'
Declare Function GetSecurityDescriptorOwner Lib "advapi32.dll" ( _
                            ByVal pSecurityDescriptor As Long, _
                            pOwner As Long, _
                            lpbOwnerDefaulted As Long) As Long

'------------------------------------------------------
' セキュリティ情報よりグループSID取得
'------------------------------------------------------
' [I] pSecurityDescriptor : SD(セキュリティ記述子)
' [O] pGroup              : グループSID
' [O] pbGroupDefaulted    : デフォルトグループの場合(True)
'
'     戻り値              : 0以外 = 成功
'                         : 0     = 失敗
'
Declare Function GetSecurityDescriptorGroup Lib "advapi32.dll" ( _
                            ByVal pSecurityDescriptor As Long, _
                            pGroup As Long, _
                            pbGroupDefaulted As Long) As Long

'------------------------------------------------------
' セキュリティ情報より任意ACL取得
'------------------------------------------------------
' [I] pSecurityDescriptor : SD(セキュリティ記述子)
' [O] lpbDaclPresent      : 任意ACLがある場合(True)
' [O] pDacl               : 任意ACLのポインタ
' [O] lpbDaclDefaulted    : デフォルト任意ACLの場合(True)
'
'     戻り値              : 0以外 = 成功
'                         : 0     = 失敗
'
Declare Function GetSecurityDescriptorDacl Lib "advapi32.dll" ( _
                            ByVal pSecurityDescriptor As Long, _
                            lpbDaclPresent As Long, _
                            pDacl As Long, _
                            lpbDaclDefaulted As Long) As Long

'------------------------------------------------------
' ACL情報の取得
'------------------------------------------------------
' [I] pAcl                  : 対象となるACL
' [O] pAclInformation       : 取得したACL情報
' [I] nAclInformationLength : pAclInformationのサイズ
' [I] dwAclInformationClass : 取得情報タイプ(ACL_INFORMATION_CLASS)
'
'     戻り値                : 0以外 = 成功
'                           : 0     = 失敗
'
Declare Function GetAclInformation Lib "advapi32.dll" ( _
                            ByVal pAcl As Long, _
                            pAclInformation As Any, _
                            ByVal nAclInformationLength As Long, _
                            ByVal dwAclInformationClass As ACL_INFORMATION_CLASS) As Long

'------------------------------------------------------
' ACE情報の取得
'------------------------------------------------------
' [I] pAcl          : 対象となるACL
' [I] dwAceIndex    : 取得するACEの位置(0が最初)
' [O] pAce          : 取得したACEへのポインタ
'
'     戻り値        : 0以外 = 成功
'                   : 0     = 失敗
'
Declare Function GetAce Lib "advapi32.dll" ( _
                            ByVal pAcl As Long, _
                            ByVal dwAceIndex As Long, _
                            pAce As Any) As Long

' ボリューム情報取得
'------------------------------------------------------
' [ I ] lpRootPathName            : ルートディレクトリ名
' [I/O] lpVolumeNameBuffer        : ボリューム名
' [I/O] nVolumeNameSize           : lpVolumeNameBufferのサイズ
' [I/O] lpVolumeSerialNumber      : ボリュームシリアルナンバー
' [I/O] lpMaximumComponentLength  : ファイル名構成要素の最大長
' [I/O] lpFileSystemFlags         : ファイルシステムフラグ
' [I/O] lpFileSystemNameBuffer    : ファイルシステム名
' [I/O] nFileSystemNameSize       : lpFileSystemNameBufferのサイズ
'
'           戻り値                : 0以外 = 正常
'                                 : 0     = 失敗
'
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
'add ed 2009/4/3
Public Function IsSECURITY(ByVal strFilePath As String) As Boolean
    Dim lngRet As Long                          ' 戻り値
    Dim lngSd As Long                           ' SD(セキュリティ記述子)ポインタ
    Dim lngSdLength As Long                     ' SD(セキュリティ記述子)サイズ
    
    Dim strAccount As String                    ' アカウント名
    Dim strDomain As String                     ' ドメイン名
    Dim lngUse As Long                          ' 説明タイプ
'    Dim strFilePath As String                   ' 対象ファイルフルパス
    
    Dim lngDacl As Long                         ' 任意ACLポインタ
    Dim lngDaclPresent As Long                  ' 任意ACLの有無
    Dim lngDaclDefaulted As Long                ' デフォルト任意ACLフラグ
    
    Dim tAclSizeInfo As ACL_SIZE_INFORMATION    ' ACL_SIZE_INFORMATION 構造体
    Dim lngAceCount As Long                     ' ACLに含まれるACEの数
    
    Dim i As Long                               ' ループカウンタ
    Dim lngAce As Long                          ' ACEポインタ
    Dim tAccessAllowedAce As ACCESS_ALLOWED_ACE ' ACCESS_ALLOWED_ACE 構造体
    Dim lngSid As Long                          ' SIDポインタ
    
    Dim strLine_Account As String * 30          ' アカウント名
    Dim strLine_Permission As String            ' パーミッション

    ' 選択ドライブがNTFSかチェック
    If Not IsNTFS(strFilePath) Then
'        magb "選択ドライブはNTFSでない為、取得できません。"
        Exit Function
    End If
    
    '--------------------------------
    ' ファイルのセキュリティ情報取得
    '--------------------------------
    ' 必要なSD(セキュリティ記述子)サイズ取得
    If GetFileSecurity(strFilePath, _
                       DACL_SECURITY_INFORMATION, _
                       ByVal 0, 0, lngSdLength) = 0 Then
        If Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER Then
'            MsgBox mErr.fncGetErrorString(Err.LastDllError)
            Exit Function
        End If
    End If
    ' 必要なSD(セキュリティ記述子)サイズ確保
    lngSd = GlobalAlloc(GMEM_FIXED, lngSdLength)
    ' ファイルのセキュリティ情報取得
    If GetFileSecurity(strFilePath, _
                       DACL_SECURITY_INFORMATION, _
                       ByVal lngSd, ByVal lngSdLength, lngSdLength) = 0 Then
'        MsgBox mErr.fncGetErrorString(Err.LastDllError)
        Call GlobalFree(lngSd)
        Exit Function
    End If
    
    '--------------------------------
    ' 任意ACL情報取得
    '--------------------------------
    If GetSecurityDescriptorDacl(lngSd, lngDaclPresent, lngDacl, lngDaclDefaulted) = 0 Then
'        MsgBox mErr.fncGetErrorString(Err.LastDllError)
        Call GlobalFree(lngSd)
        Exit Function
    End If
    ' 任意ACL情報がある場合
    If lngDaclPresent <> 0 Then
        ' 任意ACL情報取得
        If GetAclInformation(lngDacl, tAclSizeInfo, Len(tAclSizeInfo), AclSizeInformation) = 0 Then
'            MsgBox mErr.fncGetErrorString(Err.LastDllError)
            Call GlobalFree(lngSd)
            Exit Function
        End If
        ' ACEの列挙開始
        lngAceCount = tAclSizeInfo.AceCount
        For i = 0 To lngAceCount
            ' ACEの取得
            If GetAce(ByVal lngDacl, ByVal i, lngAce) <> 0 Then
                ' ACEバッファ構造体にコピー
                MoveMemory tAccessAllowedAce, ByVal lngAce, ByVal LenB (tAccessAllowedAce)
                ' アクセス権文字列取得
                If tAccessAllowedAce.Header.AceType = ACCESS_DENIED_ACE_TYPE Then
                    IsSECURITY = True 'アクセス権なし
                    Exit For
                End If

            End If
        Next i
    End If
    
    ' 後始末
    Call GlobalFree(lngSd)
End Function
Public Function IsNTFS(ByVal strFilePath As String) As Boolean
   Dim strVolBuffer As String
   Dim strSystemName As String
   Dim strVol As String
   Dim lngSerialNum As Long
   Dim lngSystemFlags As Long
   Dim lngComponentLen As Long
   Dim lngRet As Long
  
   strVolBuffer = String(256, 0)
   strSystemName = String(256, 0)
   strVol = UCase(Mid(strFilePath, 1, 3))
   lngRet = GetVolumeInformation(strVol, _
                                 strVolBuffer, _
                                 255, _
                                 lngSerialNum, _
                                 lngComponentLen, _
                                 lngSystemFlags, _
                                 strSystemName, _
                                 255)
   If lngRet = 0 Then
      IsNTFS = False
   Else
      If UCase(Mid(strSystemName, 1, 4)) = "NTFS" Then
         IsNTFS = True
      Else
         IsNTFS = False
      End If
   End If
End Function

[ツリー表示へ]
タイトル修正しました、その上で教えて下さい
記事No13575
投稿日: 2009/04/06(Mon) 18:55
投稿者はるちゃん
修正を加えまして、今のとこ動作しますが、1点気になります。
本文中の
If gstrDomain = strDomain And gstrUser = strAccount Or _
   strDomain = "BUILTIN" And strAccount = "Administrators"
のところですが、"Administrators"のドメインを"BUILTIN"
としているのですが、これはドメインが変われば変化するでしょうか?


-------------以下はロジックです-------------
form1
Option Explicit

Const FULLACCESS = 2032127  '--- フルアクセス(All)
Const DenyFULLACCESS = 983551   '--- 【拒否】フルアクセス(All)
Const UPDATE = 1245631      '--- 変更(RWXD)
Const DenyUPDATE = 197055   '--- 【拒否】変更(RWXD)
Const READEX = 1179817      '--- 読み取りと実行(RX)
Const DenyREADEX = 131241   '--- 【拒否】読み取りと実行(RX)
Const READ = 1179785        '--- 読み取り
Const DenyREAD = 131209     '--- 【拒否】読み取り
Const WRITEZ = 1048854       '--- 書き込み
Const DenyWRITE = 278       '--- 【拒否】書き込み
Const SR_FSFX = 1048608     '--- 特殊なアクセス権(フォルダのスキャン/ファイルの実行)
Const SR_DenySFX = 32       '--- 【拒否】特殊なアクセス権(フォルダのスキャン/ファイルの実行)
Const SR_LFRD = 1048577     '--- 特殊なアクセス権(フォルダの一覧/データの読み取り)
Const SR_DenyLFRD = 1       '--- 【拒否】特殊なアクセス権(フォルダの一覧/データの読み取り)
Const SR_RAt = 1048704      '--- 特殊なアクセス権(属性の読み取り)
Const SR_DenyRAt = 128      '--- 【拒否】特殊なアクセス権(属性の読み取り)
Const SR_RExAt = 1048584    '--- 特殊なアクセス権(拡張属性の読み取り)
Const SR_DenyRExAt = 8      '--- 【拒否】特殊なアクセス権(拡張属性の読み取り)
Const SR_CrFiWD = 1048578   '--- 特殊なアクセス権(ファイルの作成/データの書き込み)
Const SR_DenyCrFiWD = 2     '--- 【拒否】特殊なアクセス権(ファイルの作成/データの書き込み)
Const SR_CrFoAdD = 1048580  '--- 特殊なアクセス権(フォルダの作成/データの追加)
Const SR_DenyCrFoAdD = 4    '--- 【拒否】特殊なアクセス権(フォルダの作成/データの追加)
Const SR_WAt = 1048832      '--- 特殊なアクセス権(属性の書き込み)
Const SR_DenyWAt = 256      '--- 【拒否】特殊なアクセス権(属性の書き込み)
Const SR_WExAt = 1048592    '--- 特殊なアクセス権(拡張属性の書き込み)
Const SR_DenyWExAt = 16     '--- 【拒否】特殊なアクセス権(拡張属性の書き込み)
Const SR_Del = 1114112      '--- 特殊なアクセス権(削除)
Const SR_DenyDel = 65536    '--- 【拒否】削除
Const SR_RAcl = 1179648     '--- 特殊なアクセス権(アクセス許可の読み取り)
Const SR_DenyRAcl = 131072  '--- 【拒否】特殊なアクセス権(アクセス許可の読み取り)
Const SR_ChAcl = 1310720    '--- 特殊なアクセス権(アクセス権の変更)
Const SR_DenyChAcl = 262144 '--- 【拒否】特殊なアクセス権(アクセス権の変更)
Const SR_GOwn = 1572864     '--- 特殊なアクセス権(所有権の取得)
Const SR_DenyGOwn = 524288  '--- 【拒否】特殊なアクセス権(所有権の取得)

'--------------------------------------
' アクセスパーミッション文字列から説明
'--------------------------------------
' [I] lngAceType : ACEタイプ
' [I] lngMask    : アクセスマスク
'
'         戻り値 : アクセス権を表す文字列
'
Private Function pfncGetMaskString(ByVal lngAceType As Long, ByVal lngMask As Long) As String
    Dim strMASK As String
    Debug.Print lngMask
    If lngAceType = ACCESS_DENIED_ACE_TYPE Then
        Select Case lngMask
            Case FULLACCESS 'フルコントロール(All)
            Case UPDATE ' "変更(RWXD) : "
            Case READEX '"読み取りと実行(RX) :
            Case READ '"読み取り : "
            Case WRITEZ '"書き込み : "
            Case DenyREADEX '"読み取り実行(拒否) :
                pfncGetMaskString = "読み取り実行(拒否)"
            
'                IsSECURITY = True
            Case DenyWRITE ' "書き込み(拒否) : "
'            Debug.Print "ddd"
            Case DenyREAD ' "読み取り(拒否) :
            pfncGetMaskString = "読み取り(拒否)"
'                IsSECURITY = True
'                GoTo IsSECURITY_exit
            Case 131487 '"読み取り・書き込み(拒否) : "
            pfncGetMaskString = "読み取り・書き込み(拒否) "
'                IsSECURITY = True
'                GoTo IsSECURITY_exit
            Case 131519 '"読み取り実行・読み取り・書き込み(拒否) : "
                pfncGetMaskString = "読み取り実行・読み取り・書き込み(拒否) "
'                IsSECURITY = True
'                GoTo IsSECURITY_exit
            Case DenyREADEX '"読み取り実行(拒否) : "
'                pfncGetMaskString = "アクセス権なし(なし)"
                pfncGetMaskString = "読み取り実行(拒否)"
            Case DenyFULLACCESS '"フルアクセス(拒否) : "
'                pfncGetMaskString = "アクセス権なし(なし)"
                pfncGetMaskString = "フルアクセス(拒否)"
                
            Case DenyUPDATE '"変更(拒否) : "
'                pfncGetMaskString = "アクセス権なし(なし)"
                pfncGetMaskString = "変更(拒否) "
            Case Else '"その他のアクセス権 :
                pfncGetMaskString = "アクセス権なし(なし)"
            End Select
    End If
End Function
Private Sub Command1_Click()
    Dim strDomain As String
    Dim strUser As String
    Dim strDir As String
    Dim strFilename As String
    strDir = "C:\"
    strFilename = "a.txt"
    If whoami(strDomain, strUser) Then
        If IsSECURITY(strDomain, strUser, strDir & strFilename) Then
            MsgBox ("ファイルのアクセス権限がありません")
        End If
    End If
End Sub

'-----------------------------------
' ファイルが選択された
'-----------------------------------
Public Function IsSECURITY(ByVal gstrDomain As String, ByVal gstrUser As String, ByVal strFilePath As String) As Boolean

    Dim lngRet As Long                          ' 戻り値
    Dim lngSd As Long                           ' SD(セキュリティ記述子)ポインタ
    Dim lngSdLength As Long                     ' SD(セキュリティ記述子)サイズ
    
    Dim strAccount As String                    ' アカウント名
    Dim strDomain As String                     ' ドメイン名
    Dim lngUse As Long                          ' 説明タイプ
'    Dim strFilePath As String                   ' 対象ファイルフルパス
    
    Dim lngDacl As Long                         ' 任意ACLポインタ
    Dim lngDaclPresent As Long                  ' 任意ACLの有無
    Dim lngDaclDefaulted As Long                ' デフォルト任意ACLフラグ
    
    Dim tAclSizeInfo As ACL_SIZE_INFORMATION    ' ACL_SIZE_INFORMATION 構造体
    Dim lngAceCount As Long                     ' ACLに含まれるACEの数
    
    Dim i As Long                               ' ループカウンタ
    Dim lngAce As Long                          ' ACEポインタ
    Dim tAccessAllowedAce As ACCESS_ALLOWED_ACE ' ACCESS_ALLOWED_ACE 構造体
    Dim lngSid As Long                          ' SIDポインタ
    
    Dim strLine_Account As String * 30          ' アカウント名
    Dim strLine_Permission As String            ' パーミッション
    
    
    ' 選択されたファイルをフルパスに

'    If Right(strFilePath, 1) <> "\" Then strFilePath = strFilePath & "\"
'    strFilePath = strFilePath & File1
    ' 選択ドライブがNTFSかチェック
    If Not IsNTFS(strFilePath) Then
        MsgBox "選択ドライブはNTFSでない為、取得できません。"
        
        Exit Function
    End If
    
    '--------------------------------
    ' ファイルのセキュリティ情報取得
    '--------------------------------
    ' 必要なSD(セキュリティ記述子)サイズ取得
    If GetFileSecurity(strFilePath, _
                       DACL_SECURITY_INFORMATION, _
                       ByVal 0, 0, lngSdLength) = 0 Then
        If Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER Then
'            MsgBox mErr.fncGetErrorString(Err.LastDllError)
            MsgBox Err.Description
            Exit Function
        End If
    End If
    ' 必要なSD(セキュリティ記述子)サイズ確保
    lngSd = GlobalAlloc(GMEM_FIXED, lngSdLength)
    ' ファイルのセキュリティ情報取得
    If GetFileSecurity(strFilePath, _
                       DACL_SECURITY_INFORMATION, _
                       ByVal lngSd, ByVal lngSdLength, lngSdLength) = 0 Then
'        MsgBox mErr.fncGetErrorString(Err.LastDllError)
         MsgBox Err.Description
        Call GlobalFree(lngSd)
        Exit Function
    End If
    
    '--------------------------------
    ' 任意ACL情報取得
    '--------------------------------
    If GetSecurityDescriptorDacl(lngSd, lngDaclPresent, lngDacl, lngDaclDefaulted) = 0 Then
'        MsgBox mErr.fncGetErrorString(Err.LastDllError)
         MsgBox Err.Description
        Call GlobalFree(lngSd)
        Exit Function
    End If
    ' 任意ACL情報がある場合
    If lngDaclPresent <> 0 Then
        ' 任意ACL情報取得
        If GetAclInformation(lngDacl, tAclSizeInfo, Len(tAclSizeInfo), AclSizeInformation) = 0 Then
'            MsgBox mErr.fncGetErrorString(Err.LastDllError)
             MsgBox Err.Description
            Call GlobalFree(lngSd)
            Exit Function
        End If
        ' ACEの列挙開始
        lngAceCount = tAclSizeInfo.AceCount
        For i = 0 To lngAceCount
            ' ACEの取得
            If GetAce(ByVal lngDacl, ByVal i, lngAce) <> 0 Then
                ' ACEバッファ構造体にコピー
                MoveMemory tAccessAllowedAce, ByVal lngAce, ByVal LenB(tAccessAllowedAce)
                ' アクセス権文字列取得
                If tAccessAllowedAce.Header.AceType = ACCESS_DENIED_ACE_TYPE Then

                    ' SIDよりアカウント名取得
                    lngSid = lngAce + 8 ' SID開始位置を求めるために取得ポインタに+8する
                    Call pfncLookupAccountSid(ByVal lngSid, strDomain, strAccount)
                    strLine_Account = strDomain & "\" & strAccount
                    If gstrDomain = strDomain And gstrUser = strAccount Or _
                        strDomain = "BUILTIN" And strAccount = "Administrators" Then
                        With tAccessAllowedAce
                            strLine_Permission = pfncGetMaskString(.Header.AceType, .Mask)
                        End With
                        If strLine_Permission <> "" Then
                            IsSECURITY = True
                             GoTo IsSECURITY_ext
                        End If
                        ' リストボックスに追加
'                        List1.AddItem strLine_Account & strLine_Permission
                    End If
                End If
            End If
        Next i
    End If
    
IsSECURITY_ext:

    ' 後始末
    Call GlobalFree(lngSd)
End Function


Public Function whoami(ByRef strDomainName As String, _
                       ByRef strUserName As String) As Boolean

    Dim lngRet As Long              ' 戻り値
    Dim hToken As Long              ' トークンハンドル
    Dim tBuffer() As Long           ' バッファ
    Dim lngReturnLength As Long     ' 取得バッファサイズ
    Dim lngUse As Long              ' 説明タイプ

    ' 初期戻り値セット
    whoami = False

    ' プロセスのアクセストークンオープン
    If Not CBool(OpenProcessToken(GetCurrentProcess(), _
                                  TOKEN_READ, _
                                  hToken)) Then
        Exit Function
    End If

    ' トークンインフォメーションバッファ確保
    ReDim tBuffer((1000 \ 4) - 1)
    ' トークンインフォメーション取得
    If Not CBool(GetTokenInformation(hToken, _
                                     TokenUser, _
                                     tBuffer(0), _
                                     1000, _
                                     lngReturnLength)) Then
        Exit Function
    End If
                                    
    ' SIDより説明取得
    If Not CBool(fncLookupAccountSid(vbNullString, _
                                     tBuffer(), _
                                     strUserName, _
                                     strDomainName, _
                                     lngUse)) Then
        Exit Function
    End If
    
    ' 戻り値セット
    whoami = True
End Function

'-----------------------------------
' SIDよりアカウント情報取得
'-----------------------------------
' [ I ] lngSID     : SID
' [I/O] strDomain  : ドメイン名
' [I/O] strAccount : アカウント名
'
'           戻り値 : LookupAccountSid 関数の戻り値
'
Private Function pfncLookupAccountSid(ByVal lngSid As Long, _
                                      ByRef strDomain As String, _
                                      ByRef strAccount As String) As Long
    Dim lngAccountLen As Long   ' アカウント名サイズ
    Dim lngDomainLen As Long    ' ドメイン名サイズ
    Dim lngUse As Long          ' 説明タイプ
    
    ' SID情報を格納するバッファサイズ取得
    pfncLookupAccountSid = LookupAccountSid("", _
                                            ByVal lngSid, _
                                            ByVal strAccount, _
                                            lngAccountLen, _
                                            ByVal strDomain, _
                                            lngDomainLen, _
                                             lngUse)
    ' SID情報を格納するバッファ確保
    If lngAccountLen = 0 Then Exit Function
    strAccount = Space(lngAccountLen - 1)
    strDomain = Space(lngDomainLen - 1)
    ' SIDより説明取得
    pfncLookupAccountSid = LookupAccountSid("", _
                                            ByVal lngSid, _
                                            strAccount, _
                                            lngAccountLen, _
                                            strDomain, _
                                            lngDomainLen, _
                                            lngUse)
End Function
'------------------------------------------------------
' NTFSチェック
'------------------------------------------------------
' [I] strFilePath : チェックするファイルパス
'
'     戻り値      : True  = NTFS
'                 : False = NTFSでない
'
Public Function IsNTFS(ByVal strFilePath As String) As Boolean
   Dim strVolBuffer As String
   Dim strSystemName As String
   Dim strVol As String
   Dim lngSerialNum As Long
   Dim lngSystemFlags As Long
   Dim lngComponentLen As Long
   Dim lngRet As Long
  
   strVolBuffer = String(256, 0)
   strSystemName = String(256, 0)
   strVol = UCase(Mid(strFilePath, 1, 3))
   lngRet = GetVolumeInformation(strVol, _
                                 strVolBuffer, _
                                 255, _
                                 lngSerialNum, _
                                 lngComponentLen, _
                                 lngSystemFlags, _
                                 strSystemName, _
                                 255)
   If lngRet = 0 Then
      IsNTFS = False
   Else
      If UCase(Mid(strSystemName, 1, 4)) = "NTFS" Then
         IsNTFS = True
      Else
         IsNTFS = False
      End If
   End If
End Function

[ツリー表示へ]