タイトル | : 修正しました、その上で教えて下さい |
記事No | : 13575 |
投稿日 | : 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
|