查看与更改NTFS文件夹权限
来源：互联网 发布：linux中怎么打开终端 编辑：程序博客网 时间：2024/04/27 17:49
最近写的一个可以查看并且更改NTFS文件夹访问权限的小工具。
http://www.geocities.com/james0001csdn/NTFSSecurity.zip
主要用到的 API 函数：
GetNamedSecurityInfo - 用来得到一个文件夹的权限列表。
SetNamedSecurityInfo - 用来设置一个文件夹的权限（需要有足够权限）。
AddAce - 用来获得/修改权限列表项目信息。
DeleteAce
GetAce
frmMain.frm - 工程唯一需要的主窗口文件（没来得及注释）
VERSION 5.00Begin VB.Form frmMain BorderStyle = 1 'Fixed Single Caption = "NTFS文件夹权限" ClientHeight = 6495 ClientLeft = 1620 ClientTop = 435 ClientWidth = 5250 HasDC = 0 'False LinkTopic = "frmMain" LockControls = -1 'True MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 433 ScaleMode = 3 'Pixel ScaleWidth = 350 Begin VB.ComboBox cmbInherit Enabled = 0 'False Height = 315 Left = 1170 Style = 2 'Dropdown List TabIndex = 13 Top = 5550 Width = 3930 End Begin VB.CommandButton cmdSave Caption = "保存文件夹权限(&S)" Enabled = 0 'False Height = 345 Left = 3405 TabIndex = 4 Top = 405 Width = 1710 End Begin VB.CommandButton cmdOpenDir Caption = "打开(&O)" Height = 345 Left = 2535 TabIndex = 3 Top = 405 Width = 855 End Begin VB.CommandButton cmdDel Caption = "删除项目(&D)" Enabled = 0 'False Height = 390 Left = 3915 TabIndex = 16 Top = 6000 Width = 1230 End Begin VB.CommandButton cmdModify Caption = "修改项目(&M)" Enabled = 0 'False Height = 390 Left = 2670 TabIndex = 15 Top = 6000 Width = 1230 End Begin VB.CommandButton cmdAdd Caption = "添加到权限项目列表(&A)" Enabled = 0 'False Height = 390 Left = 135 TabIndex = 14 Top = 6000 Width = 2220 End Begin VB.ListBox lstAccess Enabled = 0 'False Height = 1860 Left = 135 Style = 1 'Checkbox TabIndex = 11 Top = 3630 Width = 4965 End Begin VB.CommandButton cmdUserCheck Caption = "检查(&C)" Enabled = 0 'False Height = 300 Left = 4395 TabIndex = 9 Top = 2985 Width = 720 End Begin VB.TextBox txtUser Enabled = 0 'False Height = 285 Left = 915 TabIndex = 8 Top = 3000 Width = 3435 End Begin VB.ListBox lstAces Enabled = 0 'False Height = 1620 Left = 135 TabIndex = 6 Top = 1155 Width = 4965 End Begin VB.CommandButton cmdDir Caption = "&..." Height = 300 Left = 4770 TabIndex = 2 Top = 45 Width = 345 End Begin VB.TextBox txtDir Height = 300 Left = 1020 OLEDropMode = 1 'Manual TabIndex = 1 Top = 60 Width = 3690 End Begin VB.Label lblInherit AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "应用到(&P)：" Enabled = 0 'False Height = 195 Left = 150 TabIndex = 12 Top = 5610 Width = 915 End Begin VB.Line lneSeparator BorderColor = &H80000015& Index = 3 X1 = 6 X2 = 344 Y1 = 192 Y2 = 192 End Begin VB.Line lneSeparator BorderColor = &H80000014& Index = 2 X1 = 6 X2 = 344 Y1 = 193 Y2 = 193 End Begin VB.Label lblAccess AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "权限（允许）(&E)：" Enabled = 0 'False Height = 195 Left = 150 TabIndex = 10 Top = 3360 Width = 1455 End Begin VB.Label lblUser AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "名称(&N)：" Enabled = 0 'False Height = 195 Left = 150 TabIndex = 7 Top = 3045 Width = 750 End Begin VB.Label lblAces AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "文件夹权限项目(&I)：" Enabled = 0 'False Height = 195 Left = 120 TabIndex = 5 Top = 885 Width = 1575 End Begin VB.Line lneSeparator BorderColor = &H80000015& Index = 1 X1 = 6 X2 = 344 Y1 = 53 Y2 = 53 End Begin VB.Line lneSeparator BorderColor = &H80000014& Index = 0 X1 = 6 X2 = 344 Y1 = 54 Y2 = 54 End Begin VB.Label lblDir AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "文件夹(&R)：" Height = 195 Left = 105 TabIndex = 0 Top = 120 Width = 930 EndEndAttribute VB_Name = "frmMain"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = False'''''''''' James'Option ExplicitPrivate Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (ByRef pDest As Any, ByRef pSrc As Any, ByVal iCb As Long)Private Declare Function FormatMessageW Lib "kernel32" (ByVal dwFlags As Long, ByVal lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As Long, ByVal nSize As Long, Arguments As Any) As LongPrivate Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000Private Enum SE_OBJECT_TYPE SE_UNKNOWN_OBJECT_TYPE = 0& SE_FILE_OBJECT SE_SERVICE SE_PRINTER SE_REGISTRY_KEY SE_LMSHARE SE_KERNEL_OBJECT SE_WINDOW_OBJECT SE_DS_OBJECT SE_DS_OBJECT_ALL SE_PROVIDER_DEFINED_OBJECT SE_WMIGUID_OBJECT SE_REGISTRY_WOW64_32KEYEnd EnumPrivate Const OWNER_SECURITY_INFORMATION = (&H1&)Private Const GROUP_SECURITY_INFORMATION = (&H2&)Private Const DACL_SECURITY_INFORMATION = (&H4&)Private Const SACL_SECURITY_INFORMATION = (&H8&)Private Const PROTECTED_DACL_SECURITY_INFORMATION = (&H80000000)Private Const PROTECTED_SACL_SECURITY_INFORMATION = (&H40000000)Private Const UNPROTECTED_DACL_SECURITY_INFORMATION = (&H20000000)Private Const UNPROTECTED_SACL_SECURITY_INFORMATION = (&H10000000)Private Declare Function SetNamedSecurityInfoW Lib "advapi32" (ByVal pObjectName As Long, ByVal ObjectType As SE_OBJECT_TYPE, ByVal SecurityInfo As Long, ByRef psidOwner As Any, ByRef psidGroup As Any, ByRef pDacl As Any, ByRef pSacl As Any) As LongPrivate Declare Function GetNamedSecurityInfoW Lib "advapi32" (ByVal pObjectName As Long, ByVal ObjectType As SE_OBJECT_TYPE, ByVal SecurityInfo As Long, ByRef psidOwner As Any, ByRef psidGroup As Any, ByRef pDacl As Any, ByRef pSacl As Any, ByRef ppSecurityDescriptor As Any) As LongPrivate Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As LongPrivate Const BIF_RETURNONLYFSDIRS = &H1& ' For finding a folder to start document searchingPrivate Const BIF_DONTGOBELOWDOMAIN = &H2& ' For starting the Find ComputerPrivate Const BIF_STATUSTEXT = &H4& ' Top of the dialog has 2 lines of text for BROWSEINFO.lpszTitle and one line if ' this flag is set. Passing the message BFFM_SETSTATUSTEXTA to the hwnd can set the ' rest of the text. This is not used with BIF_USENEWUI and BROWSEINFO.lpszTitle gets ' all three lines of text.Private Const BIF_RETURNFSANCESTORS = &H8&Private Const BIF_EDITBOX = &H10& ' Add an editbox to the dialogPrivate Const BIF_VALIDATE = &H20& ' insist on valid result (or CANCEL)Private Const BIF_NEWDIALOGSTYLE = &H40& ' Use the new dialog layout with the ability to resize ' Caller needs to call OleInitialize() before using this APIPrivate Const BIF_USENEWUI& = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)Private Const BIF_BROWSEINCLUDEURLS = &H80& ' Allow URLs to be displayed or entered. (Requires BIF_USENEWUI)Private Const BIF_UAHINT = &H100& ' Add a UA hint to the dialog, in place of the edit box. May not be combined with BIF_EDITBOXPrivate Const BIF_NONEWFOLDERBUTTON = &H200& ' Do not add the "New Folder" button to the dialog. Only applicable with BIF_NEWDIALOGSTYLE.Private Const BIF_NOTRANSLATETARGETS = &H400& ' don't traverse target as shortcutPrivate Const BIF_BROWSEFORCOMPUTER = &H1000& ' Browsing for Computers.Private Const BIF_BROWSEFORPRINTER = &H2000& ' Browsing for PrintersPrivate Const BIF_BROWSEINCLUDEFILES = &H4000& ' Browsing for EverythingPrivate Const BIF_SHAREABLE = &H8000& ' sharable resources displayed (remote shares, requires BIF_USENEWUI)Private Type BROWSEINFO hwndOwner As Long pidlRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfn As Long lParam As Long iImage As LongEnd TypePrivate Declare Function SHBrowseForFolderW Lib "shell32" (ByRef lpbi As BROWSEINFO) As LongPrivate Declare Function SHGetPathFromIDListW Lib "shell32" (ByVal pidl As Long, ByVal pszPath As Long) As LongPrivate Declare Function CoTaskMemAlloc Lib "ole32" (ByVal cb As Long) As LongPrivate Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As LongPrivate Enum ACL_INFORMATION_CLASS AclRevisionInformation = 1& AclSizeInformationEnd EnumPrivate Type ACL_SIZE_INFORMATION AceCount As Long AclBytesInUse As Long AclBytesFree As LongEnd TypePrivate Declare Function GetAclInformation Lib "advapi32" (ByVal pAcl As Long, ByRef pAclInformation As Any, ByVal nAclInformationLength As Long, ByVal dwAclInformationClass As ACL_INFORMATION_CLASS) As LongPrivate Const ACCESS_ALLOWED_ACE_TYPE = (&H0)Private Const ACCESS_DENIED_ACE_TYPE = (&H1)Private Const SYSTEM_AUDIT_ACE_TYPE = (&H2)Private Const SYSTEM_ALARM_ACE_TYPE = (&H3)Private Type ACE_HEADER AceType As Byte AceFlags As Byte AceSize As IntegerEnd TypePrivate Type ACCESS_ALLOWED_ACE Header As ACE_HEADER Mask As Long SidStart As LongEnd TypePrivate Const MAX_DWORD = (&HFFFFFFFF)Private Declare Function InitializeAcl Lib "advapi32" (ByVal pAcl As Long, ByVal nAclLength As Long, ByVal dwAclRevision As Long) As LongPrivate Declare Function AddAce Lib "advapi32" (ByVal pAcl As Long, ByVal dwAceRevision As Long, ByVal dwStartingAceIndex As Long, ByRef pAceList As Any, ByVal nAceListLength As Long) As LongPrivate Declare Function GetAce Lib "advapi32" (ByVal pAcl As Long, ByVal dwAceIndex As Long, ByRef pAce As Long) As LongPrivate Declare Function DeleteAce Lib "advapi32" (ByVal pAcl As Long, ByVal dwAceIndex As Long) As LongPrivate Const ACL_REVISION = (2&)Private Const ACL_REVISION_DS = (4&)Private Declare Function LookupAccountSidW Lib "advapi32" (ByVal lpSystemName As Long, ByVal lpSid As Long, ByVal lpName As Long, ByRef cchName As Long, ByVal lpReferencedDomainName As Long, ByRef cchReferencedDomainName As Long, ByRef peUse As Long) As LongPrivate Declare Function LookupAccountNameW Lib "advapi32" (ByVal lpSystemName As Long, ByVal lpAccountName As Long, ByVal Sid As Long, ByRef cbSid As Long, ByVal ReferencedDomainName As Long, ByRef cchReferencedDomainName As Long, ByRef peUse As Long) As LongPrivate Const FILE_DELETE = (&H10000)Private Const FILE_READ_CONTROL = (&H20000)Private Const FILE_WRITE_DAC = (&H40000)Private Const FILE_WRITE_OWNER = (&H80000)Private Const FILE_LIST_DIRECTORY = (&H1&) ' directoryPrivate Const FILE_ADD_FILE = (&H2&) ' directoryPrivate Const FILE_ADD_SUBDIRECTORY = (&H4&) ' directoryPrivate Const FILE_READ_EA = (&H8&) ' file & directoryPrivate Const FILE_WRITE_EA = (&H10&) ' file & directoryPrivate Const FILE_TRAVERSE = (&H20&) ' directoryPrivate Const FILE_DELETE_CHILD = (&H40&) ' directoryPrivate Const FILE_READ_ATTRIBUTES = (&H80&) ' allPrivate Const FILE_WRITE_ATTRIBUTES = (&H100&) ' allPrivate Const OBJECT_INHERIT_ACE = (&H1)Private Const CONTAINER_INHERIT_ACE = (&H2)Private Const NO_PROPAGATE_INHERIT_ACE = (&H4)Private Const INHERIT_ONLY_ACE = (&H8)Private Const INHERITED_ACE = (&H10)Private Const VALID_INHERIT_FLAGS = (&H1F)Private Const MAX_PATH = 260&Private Const TRUEAPI = 1&Private Const FALSEAPI = 0&Private Const NULLAPI = 0&Private Const ERROR_SUCCESS = 0&Private Const DOMAIN_SEP = "/"Private Const MAX_DACL = &HFFFF&Dim m_dirDacl As Long, m_dirDaclBytes(0& To MAX_DACL - 1&) As BytePrivate Function GetSid(ByVal sAccount As String) As Byte() Dim bSid() As Byte, lSid As Long, sDom As String, lDom As Long, lUse As Long LookupAccountNameW ByVal NULLAPI, ByVal StrPtr(sAccount), _ ByVal NULLAPI, lSid, ByVal NULLAPI, lDom, lUse ReDim bSid(0& To 0&) If lSid > 0& Then ReDim bSid(0& To lSid - 1&) If lDom > 0& Then sDom = Space$(lDom - 1&) If LookupAccountNameW(ByVal NULLAPI, ByVal StrPtr(sAccount), _ ByVal VarPtr(bSid(0&)), lSid, ByVal StrPtr(sDom), lDom, lUse) Then End If End If GetSid = bSidEnd FunctionPrivate Function GetName(ByRef bSid() As Byte) As String GetName = GetNameEx(VarPtr(bSid(0&)))End FunctionPrivate Function GetNameEx(ByVal pSid As Long) As String Dim sAcc As String, lAcc As Long, sDom As String, lDom As Long, lUse As Long LookupAccountSidW ByVal NULLAPI, ByVal pSid, _ ByVal NULLAPI, lAcc, ByVal NULLAPI, lDom, lUse GetNameEx = vbNullString If lAcc > 1& Then sAcc = Space$(lAcc - 1&) If lDom > 0& Then sDom = Space$(lDom - 1&) If LookupAccountSidW(ByVal NULLAPI, ByVal pSid, _ ByVal StrPtr(sAcc), lAcc, ByVal StrPtr(sDom), lDom, lUse) Then If sDom = sAcc Then GetNameEx = sAcc Else GetNameEx = sDom & DOMAIN_SEP & sAcc End If End If End IfEnd FunctionPrivate Function CheckName() As Boolean Dim tSid() As Byte, tAcc As String tSid = GetSid(txtUser.Text) If UBound(tSid) > 0& Then tAcc = GetName(tSid) If tAcc <> vbNullString Then txtUser.Text = tAcc CheckName = True Exit Function End If End If MsgBox "无效名称！", vbExclamation CheckName = FalseEnd FunctionPrivate Sub CopyDacl(ByVal pDaclSrc As Long, ByVal pDaclDest As Long, ByVal iDestLen As Long) Dim daclSize As ACL_SIZE_INFORMATION, srcFAce As Long, i As Long, aceH As ACE_HEADER If GetAclInformation(pDaclSrc, daclSize, Len(daclSize), AclSizeInformation) Then If InitializeAcl(pDaclDest, iDestLen, ACL_REVISION) Then For i = 0& To daclSize.AceCount - 1& If GetAce(pDaclSrc, i, srcFAce) Then CopyMem aceH, ByVal srcFAce, Len(aceH) AddAce pDaclDest, ACL_REVISION, MAX_DWORD, ByVal srcFAce, CLng(aceH.AceSize) End If Next End If End IfEnd SubPrivate Sub cmbInherit_Click() With cmbInherit If (.ListIndex = 0) Or (.ListIndex = 8) Then cmdAdd.Enabled = False Else cmdAdd.Enabled = True End If End WithEnd SubPrivate Function AddAceAt(ByVal iIndex As Long) As Boolean Dim nAce() As Byte, bSid() As Byte, lAceS As Long, nAceH As ACCESS_ALLOWED_ACE, i As Long If CheckName Then With nAceH .Header.AceType = ACCESS_ALLOWED_ACE_TYPE .Header.AceFlags = cmbInherit.ItemData(cmbInherit.ListIndex) For i = 0& To lstAccess.ListCount - 1& If lstAccess.Selected(i) Then .Mask = .Mask Or lstAccess.ItemData(i) Next bSid = GetSid(txtUser.Text) lAceS = Len(nAceH) - Len(nAceH.SidStart) + UBound(bSid) + 1& .Header.AceSize = lAceS ReDim nAce(lAceS - 1&) CopyMem nAce(0&), nAceH, Len(nAceH) - Len(nAceH.SidStart) CopyMem nAce(Len(nAceH) - Len(nAceH.SidStart)), bSid(0&), UBound(bSid) + 1& If AddAce(m_dirDacl, ACL_REVISION, iIndex, nAce(0&), lAceS) Then AddAceAt = True Exit Function End If End With End If AddAceAt = False MsgBox "添加权限时发生错误！", vbExclamationEnd FunctionPrivate Sub cmdAdd_Click() AddAceAt MAX_DWORD BuildAceList m_dirDaclEnd SubPrivate Sub cmdDel_Click() DeleteAce m_dirDacl, lstAces.ItemData(lstAces.ListIndex) BuildAceList m_dirDaclEnd SubPrivate Sub cmdDir_Click()cmdDir_Start: Dim bi As BROWSEINFO, lpidl As Long, sDName As String With bi .hwndOwner = Me.hWnd .lpfn = NULLAPI .lpszTitle = StrPtr("请选择要打开的文件夹") .pidlRoot = NULLAPI .pszDisplayName = NULLAPI .ulFlags = BIF_NEWDIALOGSTYLE Or BIF_RETURNFSANCESTORS Or BIF_RETURNONLYFSDIRS End With lpidl = SHBrowseForFolderW(bi) If lpidl Then sDName = String$(MAX_PATH, vbNullChar) If SHGetPathFromIDListW(lpidl, StrPtr(sDName)) Then txtDir.Text = Left$(sDName, lstrlenW(StrPtr(sDName))) Else MsgBox "无效目录！", vbExclamation CoTaskMemFree lpidl GoTo cmdDir_Start End If CoTaskMemFree lpidl End IfEnd SubPrivate Sub cmdModify_Click() Dim lPos As Long lPos = lstAces.ItemData(lstAces.ListIndex) If AddAceAt(lPos) Then DeleteAce m_dirDacl, lPos + 1& BuildAceList m_dirDacl End IfEnd SubPrivate Sub cmdOpenDir_Click() Dim sDir As String, tSD As Long, tAcl As Long, lErr As Long sDir = txtDir.Text 'If Right$(sDir, 1&) <> "/" Then sDir = sDir & "/" lErr = GetNamedSecurityInfoW(StrPtr(sDir), _ SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, _ ByVal NULLAPI, ByVal NULLAPI, tAcl, ByVal NULLAPI, tSD) If lErr = _ ERROR_SUCCESS Then EnableAces True m_dirDacl = VarPtr(m_dirDaclBytes(0&)) CopyDacl tAcl, m_dirDacl, MAX_DACL BuildAceList m_dirDacl LocalFree tSD cmdSave.Enabled = True Else MsgBox "无法获得文件夹权限信息！" & vbNewLine & _ "错误：" & Hex(lErr) & "," & vbTab & GetLastErrorString(lErr), _ vbExclamation EnableAces False lstAces.Clear End IfEnd SubPrivate Sub BuildAceList(ByVal pAcl As Long) Dim i As Long, acli As ACL_SIZE_INFORMATION, pAce As Long, sAcc As String Dim aceHeader As ACE_HEADER, aceAllow As ACCESS_ALLOWED_ACE, lUse As Long With lstAces If pAcl Then If GetAclInformation(pAcl, acli, Len(acli), AclSizeInformation) Then .Clear EnableAccesses False For i = 0& To acli.AceCount - 1& If GetAce(pAcl, i, pAce) Then CopyMem aceHeader, ByVal pAce, Len(aceHeader) If (aceHeader.AceType = ACCESS_ALLOWED_ACE_TYPE) Then sAcc = GetNameEx(pAce + (VarPtr(aceAllow.SidStart) - VarPtr(aceAllow))) If sAcc <> vbNullString Then .AddItem sAcc .ItemData(.ListCount - 1&) = i End If End If End If Next End If End If End WithEnd Sub Private Sub cmdSave_Click() Dim sDir As String, lErr As Long sDir = txtDir.Text lErr = SetNamedSecurityInfoW(StrPtr(sDir), SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, _ ByVal NULLAPI, ByVal NULLAPI, ByVal m_dirDacl, ByVal NULLAPI) If lErr = ERROR_SUCCESS Then MsgBox "成功保存文件夹权限！", vbInformation Else MsgBox "保存文件夹权限时发生错误！" & vbNewLine & _ "错误：" & Hex(lErr) & "," & vbTab & GetLastErrorString(lErr), _ vbExclamation End IfEnd SubPrivate Sub cmdUserCheck_Click() CheckNameEnd SubPrivate Sub Form_Load() With lstAccess .AddItem "遍历文件夹", 0& .ItemData(0&) = FILE_TRAVERSE .AddItem "列出文件夹", 1& .ItemData(1&) = FILE_LIST_DIRECTORY .AddItem "创建文件", 2& .ItemData(2&) = FILE_ADD_FILE .AddItem "创建文件夹", 3& .ItemData(3&) = FILE_ADD_SUBDIRECTORY .AddItem "删除子文件夹和文件", 4& .ItemData(4&) = FILE_DELETE_CHILD .AddItem "删除", 5& .ItemData(5&) = FILE_DELETE .AddItem "读取属性", 6& .ItemData(6&) = FILE_READ_ATTRIBUTES .AddItem "读取扩展属性", 7& .ItemData(7&) = FILE_READ_EA .AddItem "写入属性", 8& .ItemData(8&) = FILE_WRITE_ATTRIBUTES .AddItem "写入扩展属性", 9& .ItemData(9&) = FILE_WRITE_EA .AddItem "读取权限", 10& .ItemData(10&) = FILE_READ_CONTROL .AddItem "更改权限", 11& .ItemData(11&) = FILE_WRITE_DAC .AddItem "取得所有权", 12& .ItemData(12&) = FILE_WRITE_OWNER End With With cmbInherit .AddItem "其它", 0& .ItemData(0&) = 0& .AddItem "该文件夹", 1& .ItemData(1&) = 0& .AddItem "该文件夹和子文件夹", 2& .ItemData(2&) = CONTAINER_INHERIT_ACE .AddItem "该文件夹和文件", 3& .ItemData(3&) = OBJECT_INHERIT_ACE .AddItem "该文件夹，子文件夹和文件", 4& .ItemData(4&) = CONTAINER_INHERIT_ACE Or OBJECT_INHERIT_ACE .AddItem "子文件夹", 5& .ItemData(5&) = CONTAINER_INHERIT_ACE Or INHERIT_ONLY_ACE .AddItem "该文件夹的文件", 6& .ItemData(6&) = OBJECT_INHERIT_ACE Or INHERIT_ONLY_ACE .AddItem "子文件夹及文件", 7& .ItemData(7&) = CONTAINER_INHERIT_ACE Or OBJECT_INHERIT_ACE Or INHERIT_ONLY_ACE .AddItem "（此权限项目由父文件夹继承而来）", 8& .ItemData(8&) = INHERITED_ACE .ListIndex = 1& cmdAdd.Enabled = False End WithEnd SubPrivate Sub EnableAces(ByVal bEnable As Boolean) lblAces.Enabled = bEnable lstAces.Enabled = bEnable lblUser.Enabled = bEnable txtUser.Enabled = bEnable cmdUserCheck.Enabled = bEnable lblAccess.Enabled = bEnable lstAccess.Enabled = bEnable lstAccess.Refresh cmdAdd.Enabled = bEnable lblInherit.Enabled = bEnable cmbInherit.Enabled = bEnableEnd SubPrivate Sub EnableAccesses(ByVal bEnable As Boolean, Optional ByVal bNoModify As Boolean = False) If bNoModify Then cmdModify.Enabled = False cmdDel.Enabled = False Else cmdModify.Enabled = bEnable cmdDel.Enabled = bEnable End IfEnd SubPrivate Function SetAccess(ByVal pAcl As Long, ByVal iAceIndex As Long) As Boolean Dim pAce As Long, aceAllow As ACCESS_ALLOWED_ACE, i As Long, osel As Integer Dim sAcc As String SetAccess = False If pAcl Then If GetAce(pAcl, iAceIndex, pAce) Then CopyMem aceAllow, ByVal pAce, Len(aceAllow) sAcc = GetNameEx(pAce + (VarPtr(aceAllow.SidStart) - VarPtr(aceAllow))) If sAcc <> vbNullString Then txtUser.Text = sAcc End If With lstAccess osel = .ListIndex For i = 0& To .ListCount - 1& If (aceAllow.Mask And .ItemData(i)) = .ItemData(i) Then .Selected(i) = True Else .Selected(i) = False End If Next .ListIndex = osel .Refresh End With With cmbInherit If aceAllow.Header.AceFlags And INHERITED_ACE Then .ListIndex = 8 .ItemData(8) = aceAllow.Header.AceFlags SetAccess = True Else .ListIndex = 0 For i = 1& To .ListCount - 1& If ((aceAllow.Header.AceFlags And VALID_INHERIT_FLAGS) = .ItemData(i)) Then .ListIndex = i Exit For End If Next End If End With End If End IfEnd FunctionPrivate Sub lstAces_Click() If (lstAces.ListIndex > 0) And (lstAces.ListIndex < lstAces.ListCount) Then EnableAccesses True, SetAccess(m_dirDacl, lstAces.ItemData(lstAces.ListIndex)) End IfEnd SubPublic Function GetLastErrorString(Optional ByVal uiError As Long = 0&) As String Const LAST_ERROR_BUFER_SIZE = 260& On Error GoTo getlasterrorstring_exit If uiError = 0& Then uiError = Err.LastDllError GetLastErrorString = String$(LAST_ERROR_BUFER_SIZE, vbNullChar) GetLastErrorString = Left$(GetLastErrorString, _ FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM, ByVal NULLAPI, uiError, 0&, _ StrPtr(GetLastErrorString), LAST_ERROR_BUFER_SIZE, ByVal NULLAPI))getlasterrorstring_exit:End FunctionPrivate Sub txtDir_KeyPress(KeyAscii As Integer) If KeyAscii = vbKeyReturn Then cmdOpenDir_Click KeyAscii = 0 End IfEnd SubPrivate Sub txtDir_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) If Data.GetFormat(vbCFFiles) Then txtDir.Text = Data.Files(1&) End IfEnd SubPrivate Sub txtUser_KeyPress(KeyAscii As Integer) If KeyAscii = vbKeyReturn Then cmdUserCheck_Click KeyAscii = 0 End IfEnd SubP.S. 可以在“文件夹”文本框里输入一个文件名，这样的话可以修改文件的访问权限。
- 查看与更改NTFS文件夹权限
- 使用ASP更改 NTFS 分区中 文件夹的 读写等权限
- Ubuntu 更改文件夹权限
- Ubuntu更改文件夹权限
- Ubuntu 更改文件夹权限
- Ubuntu更改文件夹权限
- Ubuntu更改文件夹权限
- Ubuntu 更改文件夹权限
- Win7更改文件夹权限
- Win7更改文件夹权限
- Ubuntu 更改文件夹权限
- Ubuntu更改文件夹权限
- ubuntu更改文件夹权限
- 更改文件夹权限
- 查看修改文件与文件夹权限
- “您无权查看**文件夹的目前权限设置 但是, 您可以更改权限”
- linux下的目录详解与文件夹权限更改
- 设置NTFS的文件/文件夹安全权限
- Hibernate 入门
- GetInternetIP
- GetPID
- 关注Queue：Java 1.5 添加新的数据结构接口
- LockListViewHead
- 查看与更改NTFS文件夹权限
- 零碎代码
- 饮鸩止渴
- Ocean wave
- 第九期：CSDN论坛秀－Delphi版－本期作秀：ehom(？！)
- 人总是耐不住寂寞，经不起诱惑
- 为什么不能在web页面里查询数据库？
- 上个星期对以前的文章作了整理
- 用存储过程写的聊天室程序
