A recently written tool that can be viewed and changed to NTFS folder access. Http://www.geocities.com/james00019cbs/ntfssecurity.zip The primary use API function: getNameDSecurityInfo - to get a list of permissions to get a folder. SetNameDSecurityInfo - Use of permissions to set a folder (you need enough permissions). AddAce - Used to get / modify the right list project information. DeletecegetAcEfrmMain.frm - The only main window file required for the project (not comment)
Version 5.00
Begin vb.form frmmain
Borderstyle = 1 'FIXED SINGLE
CAPTION = "NTFS folder permissions"
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 = "Save Folder Permissions (& S)"
Enabled = 0 'false
HEIGHT = 345
LEFT = 3405
TabINDEX = 4
TOP = 405
Width = 1710
End
Begin vb.commandbutton cmdopendir
CAPTION = "Open (& O)"
HEIGHT = 345
LEFT = 2535
TabINDEX = 3
TOP = 405
Width = 855
End
Begin vb.commandbutton cmddel
CAPTION = "Delete Projects (& D)"
Enabled = 0 'false
Height = 390LEFT = 3915
TabINDEX = 16
TOP = 6000
Width = 1230
End
Begin vb.commandbutton cmdmodify
CAPTION = "Modify Projects (& M)"
Enabled = 0 'false
HEIGHT = 390
LEFT = 2670
TabINDEX = 15
TOP = 6000
Width = 1230
End
Begin vb.commandbutton cmdadd
CAPTION = "Add to Permissions Project List (& 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 = "Check (& 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 = 300Left = 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 = "Applied to (& P):"
Enabled = 0 'false
HEIGHT = 195
LEFT = 150
TabINDEX = 12
TOP = 5610
Width = 915
End
Begin Vb.Line LneseParator
Bordercolor = & h80000015 & h80000015 & h80000015
INDEX = 3
X1 = 6
X2 = 344
Y1 = 192
Y2 = 192
End
Begin Vb.Line LneseParator
Bordercolor = & h80000014 & h80000014
INDEX = 2
X1 = 6
X2 = 344
Y1 = 193
Y2 = 193
End
Begin vb.Label LBLACCESS
AutoSize = -1 'True
Backstyle = 0 'Transparent
CAPTION = "Permissions (Allow) (& 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 = "Name (& n):"
Enabled = 0 'false
HEIGHT = 195Left = 150
TabINDEX = 7
TOP = 3045
Width = 750
End
Begin vb.label lblace
AutoSize = -1 'True
Backstyle = 0 'Transparent
Caption = "folder permission item (& i):"
Enabled = 0 'false
HEIGHT = 195
LEFT = 120
TabINDEX = 5
TOP = 885
Width = 1575
End
Begin Vb.Line LneseParator
Bordercolor = & h80000015 & h80000015 & h80000015
INDEX = 1
X1 = 6
X2 = 344
Y1 = 53
Y2 = 53
End
Begin Vb.Line LneseParator
Bordercolor = & h80000014 & h80000014
INDEX = 0
X1 = 6
X2 = 344
Y1 = 54
Y2 = 54
End
Begin vb.label lbldir
AutoSize = -1 'True
Backstyle = 0 'Transparent
CAPTION = "folder (& R):"
HEIGHT = 195
LEFT = 105
TabINDEX = 0
TOP = 120
Width = 930
End
End
Attribute vb_name = "frmmain"
Attribute vb_globalnamespace = false
Attribute vb_creatable = false
Attribute VB_PredecLaredId = True
Attribute VB_EXPOSED = FALSE
'' '' '' ''
'James
'
Option expedition
Private 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 = & H1000
PRIVATE 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_32KEY
END ENUM
PRIVATE 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 Long
Private 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 Long
Private Declare Function Localfree Lib "Kernel AS Long) As longprivate const bif_returnonlyfsdirs = & h1 & 'for Finding a Folder to Start Document Searching
Private const bif_dontgobelowdomain = & h2 & 'for starting the find computer
Private const bif_statustext = & h4 & 'top of the dialog Has 2 Lines of text for browseinfo.lpsztitle and one line ife
'this flag is set. Passing the message bffm_setstatustexta to the hwnd can set The HWND CAN SET THE
'REST of the text. this is not buy 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 dialog
Private 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 API
Private const bif_usenewui & = (Bif_NewDialogStyle or Bif_EDitbox)
Private const bif_browseincludeurls = & h80 & 'allow urls to be displayed or entered. (Requires Bif_Usenew)
Private const bif_uahint = & h100 & 'add a ua hint to the dialog, in place of the Edit box. May not be combined with bif_editbox
Private 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' TRAVERSE TARGET AS SHORTCUT
Private const bif_browseforcomputer = & h1000 & 'browsing for computers.private const bif_browseforprinter = & h2000 &' browsing forprinters
Private const bif_browseincludefiles = & h4000 & 'browsing for everything
Private const bif_shareable = & h8000 & 'Sharable Resources Displayed (Remote Shares, Requires Bif_Usenew)
Private Type Browseinfo
HWNDOWNER AS Long
PIDLROOT AS Long
PszdisplayName As Long
LPSZTILE As Long
Ulflags as long
LPFN As Long
LPARAM As Long
IIMAGE AS Long
End Type
Private Declare Function ShbrowseForFolderw Lib "Shell32" (Byref LPBI as Browseinfo) As Long
Private Declare Function SHGETPATHFROMIDLISTW LIB "shell32" (Byval Pszpath As long) As long
Private Declare Function CotaskMalloc LIB "OLE32" (Byval CB As Long) AS Long
Private Declare Sub CotaskMemfree Lib "OLE32" (Byval PV As Long)
Private Declare Function Lstrlenw LIB "Kernel32" (Byval LPSTRING AS Long) As Long
PRIVATE ENUM ACL_INFORMATION_CLASS
AclRevisionInformation = 1 &
ACLSIZEINFORMATION
END ENUM
PRIVATE TYPE ACL_SIZE_INFORMATION
Acecount As Long
ACLBYTESINUSE As Long
ACLBYTESFREE AS Long
End Type
Private Declare Function GetAclinformation LIB "Advapi32" (ByVal Paclinformation As Any, Byval NaClinformationLEngth As AS LONG, BYVAL DWACLINFORMATIONCLASS AS AS LONG
PRIVATE 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 byteacesize as integer
End Type
PRIVATE TYPE Access_allowed_ace
Header as ace_header
Mask as long
Sidstart As Long
End Type
Private const max_dword = (& hffffff)
Private Declare Function InitializeaCl LiB "Advapi32" (Byval Pacllength As Long, Byval Dwaclrevision As Long) AS Long
Private Declare Function Addiversity LIB "Advapi32" (Byval Pacl As Long, Byval DWStartingAnDex As Long, Byref Pacelist As Any, BYVAL NaceListLength As long) As long
Private Declare Function GetAce lib "advapi32" (byval Pacl as long, byval dWaceIndex as long, byref pace as long) As long
Private Declare Function deletece lib "advapi32" (byval Pacl As Long, Byval DWACEINDEX AS Long) AS Long
Private 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 Long
Private 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 Long
Private 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 &) 'Directory
Private const file_add_file = (& H2 &) 'DirectoryPrivate const file_add_subdirectory = (& H4 &)' Directory
Private const file_read_ea = (& h8 &) 'File & Directory
Private const file_write_ea = (& H10 &) 'File & Directory
Private const file_traverse = (& H20 &) 'Directory
Private const file_delete_child = (& H40 &) 'Directory
Private const file_read_attributes = (& H80 &) 'All
Private const file_write_attributes = (& H100 &) 'All
Private 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 = & hfff &
DIM M_DIRDACL AS Long, M_Dirdaclbytes (0 & to Max_DACL - 1 &) AS BYTE
Private 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 (snaccount), _
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 = BSID
END FUNCTION
Private function getname (byref bsid () as bYTE) AS STRING
GetName = GetNameEx (Varptr (BSID (0 &))))
END FUNCTION
Private 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 IF
END FUNCTION
Private 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 "invalid name!", Vbexclamation
Checkname = false
END FUNCTION
Private sub copydacl (byval pdaclsrc as long, byval pDACLDEST AS Long, Byval Idestlen As long)
DIM Daclsize AS AS ZIZE_INFORMATION, SRCFACE AS Long, I as long, ACEH AS ACE_HEADER
IF GetAclinformation (Pdaclsrc, Daclsize, Len (Daclsize), AclsizeInformation.
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 IF
End Sub
Private sub cmbinherit_click ()
WITH CMBINHERIT
IF (.listIndex = 0) or (.listIndex = 8) THEN
cmdadd.enabled = false
Else
cmdadd.enabled = TRUE
END IF
End with
End Sub
Private function addaceat (byval Iindex as long) as boolean
Dim nace () as Byte, BSID () AS BYTE, LACID () AS BYTE, LACES AS LONG, NACEH AS Access_allowed_ace, I as Long
IF checkname dam
With Naceh
.HEADER.ACTYPE = Access_allowed_Ace_type
.Header.aceflags = cmbinherit.itemdata (cmbinherit.listindex)
For i = 0 & to Lstaccess.listcount - 1 &
If LSTACCESS.SELECTED (i) Ten .mask = .mask or lstaccess.ItemData (i)
NEXT
BSID = GetsId (txtuser.text)
Laces = LEN (NACEH) - LEN (Naceh.SIDStart Ubound (BSID) 1 &
.Header.acesize = lats
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 &) THEN
AddACeat = TRUE
EXIT FUNCTION
END IF
End with
END IF
AddACeat = FALSE
"Msgbox" Errors when adding permissions! ", Vbexclamation
END FUNCTION
Private sub cmdadd_click ()
AddACeat Max_dword
Buildacelist M_Dirdacl
End Sub
Private sub cmddel_click ()
Deleteace M_Dirdacl, Lstacs.ItemData (Lstacs.ListIndex)
Buildacelist M_Dirdacl
End Sub
Private sub cmddir_click ()
cmddir_start:
DIM BI as Browseinfo, LPIDL As Long, SDNAME AS STRING
With Bi
.hwndowner = me.hwnd
.lpfn = NULLAPI
.lpsztitle = strptr ("Please select the folder you want to open")
.pidlroot = NULLAPI
.pszdisplayName = nullapi.ulflags = bif_newdialogstyle or bif_returnfsancestors or bif_returnlyfsdirs
End with
LPIDL = SHBROWSEFORFOLDERW (BI)
IF lpidl dam
SDNAME = string $ (max_path, vbnullchar)
If ShgetPathFromidListw (LPIDL, STRPTR (SDNAME)) THEN
TXTDIR.TEXT = Left $ (SDNAME, LSTRLENW (Strptr (SDNAME)))
Else
MsgBox "invalid catalog!", Vbexclamation
Cotaskmemfree LPIDL
Goto cmddir_start
END IF
Cotaskmemfree LPIDL
END IF
End Sub
Private sub cmdmodify_click ()
DIM LPOS As Long
LPOS = Lstacs.ItemData (Lstacs.ListIndex)
IF addaceat (lpos) THEN
DELETEACE M_DIRDACL, LPOS 1 &
Buildacelist M_Dirdacl
END IF
End Sub
Private subdopendir_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 the
Enableaces true
m_dirdacl = varptr (m_dirdaclbytes (0 &))
CopyDaCl Tacl, M_Dirdacl, Max_DACL
Buildacelist M_Dirdacl
Localfree TSD
cmdsave.enabled = true
Else
Msgbox "Unable to get folder permission information!" & Vbnewline & _
"Error:" & HEX (Lerr) & "," & Vbtab & getLastErroString (LERR), _
Vbexclamation
Enableaces False
Lstacs.clear
END IF
End Sub
Private 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 aheader, Byval Pace, Len (Aceheader)
IF (ACEHEADER.ACTYPE = Access_allowed_ace_type) THEN
Sacc = GetNameex (PACE (Varptr (AceAllow.SIDStart) - Varptr (Aceallow)))
IF SACC <> vbnullstring then
.Additem snacc
.Itemdata (.Listcount - 1 &) = i
END IF
END IF
END IF
NEXT
END IF
END IF
End with
End 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 "Successfully Save Folder Permissions!", Vbinformation
Else
Msgbox "save the folder permanent error!" & VBNewline & _
"Error:" & HEX (Lerr) & "," & Vbtab & getLastErroString (LERR), _
Vbexclamation
END IF
End Sub
Private subduSerCheck_click ()
Checkname
End Sub
Private sub flow_load ()
With Lstaccess
.Additem "Traverse Folder", 0 &
.Itemdata (0 &) = file_traverse
.Additem "Lists Folders", 1 &
.Itemdata (1 &) = file_list_directory
.Additem "Created File", 2 &
.ItemData (2 &) = file_add_file
.Additem "Create Folder", 3 &
.Itemdata (3 &) = file_add_subdirectory
.Additem "Delete subfolders and files", 4 &
.Itemdata (4 &) = file_delete_child
.Additem "delete", 5 &
.Itemdata (5 &) = file_delete
.Additem "Read Properties", 6 &
.ItemData (6 &) = file_read_attributes
.Additem "Read Extension Properties", 7 &
.ItemData (7 &) = file_read_ea
.Additem "Writing Properties", 8 &
.ItemData (8 &) = file_write_attributes
.Additem "Write Extension Properties", 9 &
.ItemData (9 &) = file_write_ea
.Additem "Read Permissions", 10 &
.Itemdata (10 &) = file_read_control
.Additem "Change Permissions", 11 &
.ItemData (11 &) = file_write_dac
.Additem "get ownership", 12 &
.ItemData (12 &) = file_write_owner
End with
WITH CMBINHERIT
.Additem "Other", 0 &
.Itemdata (0 &) = 0 &
.Additem "This folder", 1 &
.Itemdata (1 &) = 0 &
.Additem "This folder and subfolders", 2 &
.Itemdata (2 &) = container_inherit_ace
.Additem "This folder and file", 3 &
.Itemdata (3 &) = Object_inherit_ace
.Additem "This folder, subfolders and files", 4 &
.Itemdata (4 &) = container_inherit_ace or object_inherit_ace
.Additem "subfolder", 5 &
.ItemData (5 &) = container_inherit_ace or inherit_only_ace
.Additem "file file", 6 &
.ItemData (6 &) = Object_inherit_ace or inherit_only_ace
.Additem "subfolders and documents", 7 &
.Itemdata (7 &) = container_inherit_ace or ibject_inherit_ace or inherit_only_ace
.Additem "(This permission project is inherited by the parent folder)", 8 &
.ItemData (8 &) = inherited_ace
.Listindex = 1 &
cmdadd.enabled = false
End with
End Sub
Private sub enableaces (Byval Benable as Boolean)
LBLACES.ENABLED = BENABLE
Lstacs.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 = benable
End Sub
Private 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 IF
End Sub
Private 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 .Indata (i)) = .ItemData (i) THEN
.Selected (i) = TRUE
Else
.Selected (i) = false
END IF
NEXT
.Listindex = OSL
.Refresh
End with
WITH CMBINHERIT
If aalthow.header.aceflags and inherited_Ace THEN
.Listindex = 8
.Itemdata (8) = acealow.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 IF
END FUNCTION
Private sub lstaces_click ()
IF (Lstacs.ListIndex> 0) and (lstaces.listindex EnableAccesses true, setaccess (m_dirdacl, lstacs.ItemData (Lstacs.ListIndex)) END IF End Sub Public Function GetLastErroString (Optional Byval Uierror As Long = 0 &) AS String Const last_error_bufer_size = 260 & ON Error Goto getLastErrorstring_exitif uierror = 0 & TEN 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 FUNCTION Private sub txtdir_keypress (Keyascii As INTEGER) IF keyascii = vbkeyreturn kil cmdopendir_click Keyascii = 0 END IF End Sub Private 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 IF End Sub Private sub txtuser_keypress (Keyascii AS Integer) IF keyascii = vbkeyreturn kil CmduSerCheck_click Keyascii = 0 END IF End Sub P.s. You can enter a file name in the Folder text box, so you can modify the file access.
