VBレスキュー(花ちゃん)の Visual Basic 6.0用掲示板

タイトル： 修正しました、その上で教えて下さい

投稿日： 2009/04/06(Mon) 18:55

投稿者： はるちゃん

修正を加えまして、今のとこ動作しますが、１点気になります。
本文中の
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

- 関連一覧ツリー （

をクリックするとツリー全体を一括表示します）

ファイルのアクセス権を判定する関数

はるちゃん

No.13572

修正しました、その上で教えて下さい - はるちゃん 09/04/06-18:55 No.13575

タイトル	：修正しました、その上で教えて下さい
投稿日	： 2009/04/06(Mon) 18:55
投稿者	：はるちゃん

古いスレッドにレスはつけられません。