Imports System.IO
Imports System.Security.AccessControl
Imports System.Security.Principal
Module Main
#Const USE_SQL_SERVER = False
#Const USE_ACCESS = True
Const AccessDBName as String = "FSDump.mdb"
#If USE_ACCESS Then
Private db As AccessDatabase
#End if
#If USE_SQL_SERVER Then
Private db As SQL_Database
#End If
Private dt_FS, dt_ACL, dt_SID As DataTable
Private first, consolidate, owner As Boolean
Private f_count, d_count, fs_count, acl_count, sid_count, err_count As Integer
Private server As String
#Region "API Region"
Private Enum AceFlags As Byte
OBJECT_INHERIT_ACE = &H1
CONTAINER_INHERIT_ACE = &H2
NO_PROPAGATE_INHERIT_ACE = &H4
INHERIT_ONLY_ACE = &H8
INHERITED_ACE = &H10
VALID_INHERIT_FLAGS = &H1F
SUCCESSFUL_ACCESS_ACE_FLAG = &H40
FAILED_ACCESS_ACE_FLAG = &H80
End Enum
Private Enum AccessTypes As Integer
DELETE = &H10000
READ_CONTROL = &H20000
WRITE_DAC = &H40000
WRITE_OWNER = &H80000
SYNCHRONIZE = &H100000
STANDARD_RIGHTS_REQUIRED = &HF0000
STANDARD_RIGHTS_READ = READ_CONTROL
STANDARD_RIGHTS_WRITE = READ_CONTROL
STANDARD_RIGHTS_EXECUTE = READ_CONTROL
STANDARD_RIGHTS_ALL = &H1F0000
SPECIFIC_RIGHTS_ALL = &HFFFF
ACCESS_SYSTEM_SECURITY = &H1000000
MAXIMUM_ALLOWED = &H2000000
GENERIC_READ = &H80000000
GENERIC_WRITE = &H40000000
GENERIC_EXECUTE = &H20000000
GENERIC_ALL = &H10000000
FILE_LIST_DIRECTORY = &H1
FILE_READ_DATA = &H1
FILE_WRITE_DATA = &H2
FILE_ADD_FILE = &H2
FILE_APPEND_DATA = &H4
FILE_ADD_SUBDIRECTORY = &H4
FILE_READ_EA = &H8
FILE_WRITE_EA = &H10
FILE_TRAVERSE = &H20
FILE_EXECUTE = &H20
FILE_DELETE_CHILD = &H40
FILE_READ_ATTRIBUTES = &H80
FILE_WRITE_ATTRIBUTES = &H100
FILE_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &H1FF
FILE_GENERIC_READ = STANDARD_RIGHTS_READ Or FILE_LIST_DIRECTORY Or FILE_READ_ATTRIBUTES Or FILE_READ_EA Or SYNCHRONIZE
FILE_GENERIC_WRITE = STANDARD_RIGHTS_WRITE Or FILE_ADD_FILE Or FILE_WRITE_ATTRIBUTES Or FILE_WRITE_EA Or FILE_ADD_SUBDIRECTORY Or SYNCHRONIZE
FILE_GENERIC_EXECUTE = STANDARD_RIGHTS_EXECUTE Or FILE_READ_ATTRIBUTES Or FILE_TRAVERSE Or SYNCHRONIZE
End Enum
#End Region
Sub Main()
Dim DDL, table, msg As String
Dim dr As DataRow
Dim start As Date
Dim el As New EventLog
start = Now
Console.WriteLine("FS_Dump_ST")
Console.WriteLine("Start: " & start)
msg = ""
' these variables just make it easier to copy-n-paste code from the
' other applications with minimal recoding
consolidate = True
owner = True
server = Environment.MachineName
Try
#IF USE_SQL_SERVER Then
db = New SQL_Database
#End If
#If USE_ACCESS Then
db = New AccessDatabase
' Make sure the db exists
' if not, create it in app directory.
db.CreateDatabase(My.Application.Info.DirectoryPath & "\" & AccessDBName)
#End if
' build the required tables
#IF USE_SQL_SERVER Then
DDL = "(ID int identity primary key, " _
& "Server varchar(50), " _
& "Path varchar(4000), " _
& "Name varchar(260), " _
& "Ext varchar(260), " _
& "FSize float, " _
& "Owner varchar(128), " _
& "Attrib varchar(15), " _
& "Modified datetime, " _
& "Created datetime, " _
& "Accessed datetime)"
#End If
#If USE_ACCESS Then
' Had to tweak the data types some.
' Some info may be lost
DDL = "(ID int identity primary key, " _
& "Server varchar(50), " _
& "Path memo, " _
& "Name memo, " _
& "Ext varchar(255), " _
& "FSize float, " _
& "Owner varchar(128), " _
& "Attrib varchar(15), " _
& "Modified datetime, " _
& "Created datetime, " _
& "Accessed datetime)"
#End If
table = server & "_FSD_" & Format(Now(), "yyMMdd")
db.CreateTable(table, DDL)
db.EmptyTable(table)
dt_FS = db.OpenTable(table)
#IF USE_SQL_SERVER Then
DDL = "(ID int identity primary key, " _
& "Server varchar(50), " _
& "Path varchar(4000), " _
& "Type varchar(10), " _
& "Name varchar(128), " _
& "Permissions varchar(255), " _
& "Inherited bit, " _
& "Scope varchar(128))"
#End If
#If USE_ACCESS Then
DDL = "(ID int identity primary key, " _
& "Server varchar(50), " _
& "Path memo, " _
& "Type varchar(10), " _
& "Name varchar(128), " _
& "Permissions varchar(255), " _
& "Inherited bit, " _
& "Scope varchar(128))"
#End If
table = server & "_ACL_" & Format(Now(), "yyMMdd")
db.CreateTable(table, DDL)
db.EmptyTable(table)
dt_ACL = db.OpenTable(table)
DDL = "(ID int identity primary key, " _
& "PC_Name varchar(50), " _
& "Drive varchar(50), " _
& "AcctName varchar(128), " _
& "AcctSID varchar(128))"
table = server & "_SID_" & Format(Now(), "yyMMdd")
db.CreateTable(table, DDL)
db.EmptyTable(table)
dt_SID = db.OpenTable(table)
Catch ex As Exception
el.Source = "FS_Dump_ST"
el.WriteEntry("Database Error" & vbCr & ex.ToString, EventLogEntryType.Error)
Exit Sub
End Try
' Okey dokey, let's get started...
For Each d As DriveInfo In DriveInfo.GetDrives
If (d.DriveType = DriveType.Fixed Or d.DriveType = DriveType.Removable) And (d.IsReady AndAlso d.DriveFormat = "NTFS") Then
Try
first = True
Console.WriteLine("")
Console.WriteLine("Scanning " & d.Name & " ")
Doit(d.Name)
' record the SID data from the Cache
For Each Sid As String In TranslateSID.SID_Cache.Keys
dr = dt_SID.NewRow
dr("PC_Name") = server
dr("Drive") = d.Name
dr("AcctName") = Left(TranslateSID.SID_Cache(Sid).ToString, 128)
dr("AcctSid") = Left(Sid, 128)
dt_SID.Rows.Add(dr)
sid_count += 1
Next
' save the SID records between drive letters
If dt_SID.Rows.Count > 0 Then
Console.Write("*")
db.UpdateTable(dt_SID)
dt_SID.Clear()
' clear the Cache between drive letters
TranslateSID.SID_Cache.Clear()
End If
Catch ex As Exception
err_count += 1
el.Source = "FS_Dump_ST"
el.WriteEntry("Internal Error" & vbCr & ex.ToString, EventLogEntryType.Warning)
' not fatal
End Try
End If
Next
' save any records still in the buffer
If dt_FS.Rows.Count > 0 Then
Console.Write("*")
db.UpdateTable(dt_FS)
End If
If dt_ACL.Rows.Count > 0 Then
Console.Write("*")
db.UpdateTable(dt_ACL)
End If
Console.WriteLine("")
msg &= "Scanned " & d_count & " directories and " & f_count & " files with " & err_count & " errors" & vbCrLf
msg &= "FS Recordcount=" & fs_count & ", ACL Recordcount=" & acl_count & ", SID Recordcount=" & sid_count & vbCrLf
msg &= "Completed: " & DateDiff(DateInterval.Minute, start, Now()) & " min" & vbCrLf
msg &= "End: " & Now()
el.Source = "FS_Dump_ST"
el.WriteEntry("Start: " & start & vbCrLf & msg, EventLogEntryType.Information)
Console.WriteLine(msg)
System.Threading.Thread.Sleep(5000)
End Sub
'
' The main entry point for this class... it reads all of the files/directories
' and records the data into the database
'
Public Sub Doit(ByVal StartingDir As String)
Dim p_di, di, di_array() As DirectoryInfoEx
Dim fi, fi_array() As FileInfoEx
Dim sid As SecurityIdentifier
Dim fsar As System.Collections.ObjectModel.ReadOnlyCollection(Of FileSystemAccessRule)
Dim LastDACL As New List(Of FileSystemAccessRule)
Dim isDifferent As Boolean
Dim i As Integer
Dim dr As DataRow
' dress it up a wee bit...
If Not StartingDir.EndsWith("\") Then
StartingDir = StartingDir & "\"
End If
' skip the recycle bin and other directories we don't care about...
For Each skip As String In My.Settings.SkipList
If StartingDir.EndsWith(skip, StringComparison.CurrentCultureIgnoreCase) Then
Exit Sub
End If
Next
Try
p_di = New DirectoryInfoEx(StartingDir)
Catch
' silently ignore these errors
Exit Sub
End Try
' get the starting directory info (first run only)
Try
If first Then
' The FS_Dump part
dr = dt_FS.NewRow
dr("Server") = server
dr("Path") = Left(StartingDir, 4000)
dr("Name") = p_di.Name
dr("Ext") = p_di.Extension.ToLower
dr("FSize") = 0
If owner Then
sid = CType(p_di.GetAccessControl.GetOwner(GetType(SecurityIdentifier)), SecurityIdentifier)
dr("Owner") = Left(TranslateSID.TranslateSidToName(server, sid), 128)
End If
dr("Attrib") = DoAttrib(p_di.Attributes)
dr("Modified") = IIf(p_di.LastWriteTime < SqlTypes.SqlDateTime.MinValue.Value, SqlTypes.SqlDateTime.MinValue.Value, p_di.LastWriteTime)
dr("Created") = IIf(p_di.CreationTime < SqlTypes.SqlDateTime.MinValue.Value, SqlTypes.SqlDateTime.MinValue.Value, p_di.CreationTime)
dr("Accessed") = IIf(p_di.LastAccessTime < SqlTypes.SqlDateTime.MinValue.Value, SqlTypes.SqlDateTime.MinValue.Value, p_di.LastAccessTime)
dt_FS.Rows.Add(dr)
fs_count += 1
' The List_ACLs part
LastDACL.Clear()
For Each ar As FileSystemAccessRule In p_di.GetAccessControl.GetAccessRules(True, True, GetType(SecurityIdentifier))
dr = dt_ACL.NewRow
dr("Server") = server
dr("Path") = Left(StartingDir, 4000)
dr("Type") = ar.AccessControlType.ToString
dr("Name") = TranslateSID.TranslateSidToName(server, CType(ar.IdentityReference, SecurityIdentifier))
dr("Permissions") = DirectoryMaskToString(ar.FileSystemRights)
dr("Inherited") = ar.IsInherited
dr("Scope") = ACEFlagToString(ar.InheritanceFlags, ar.PropagationFlags, ar.IsInherited)
dt_ACL.Rows.Add(dr)
acl_count += 1
LastDACL.Add(ar)
Next
d_count += 1
first = False
Else
If consolidate Then
' save the DACL of the current directory
LastDACL.Clear()
For Each ar As FileSystemAccessRule In p_di.GetAccessControl.GetAccessRules(True, True, GetType(SecurityIdentifier))
LastDACL.Add(ar)
Next
End If
End If
Catch ex As Exception
dr = dt_FS.NewRow
dr("Server") = server
dr("Path") = Left(StartingDir, 4000)
dr("Name") = Left("Error: " & ex.Message, 260)
dt_FS.Rows.Add(dr)
Console.Write("!")
err_count += 1
' Not fatal
End Try
' check for errors in files before we begin
Try
fi_array = p_di.GetFiles
Catch ex As Exception
dr = dt_FS.NewRow
dr("Server") = server
dr("Path") = Left(StartingDir, 4000)
dr("Name") = Left("Error: " & ex.Message, 260)
dt_FS.Rows.Add(dr)
Console.Write("!")
err_count += 1
Exit Sub
End Try
' process files before we do directories
For Each fi In fi_array
Try
dr = dt_FS.NewRow
dr("Server") = server
dr("Path") = Left(fi.FullName, 4000)
dr("Name") = fi.Name
dr("Ext") = fi.Extension.ToLower
dr("FSize") = fi.Length
If owner Then
sid = CType(fi.GetAccessControl.GetOwner(GetType(SecurityIdentifier)), SecurityIdentifier)
dr("Owner") = Left(TranslateSID.TranslateSidToName(server, sid), 128)
End If
dr("Attrib") = DoAttrib(fi.Attributes)
dr("Modified") = IIf(fi.LastWriteTime < SqlTypes.SqlDateTime.MinValue.Value, SqlTypes.SqlDateTime.MinValue.Value, fi.LastWriteTime)
dr("Created") = IIf(fi.CreationTime < SqlTypes.SqlDateTime.MinValue.Value, SqlTypes.SqlDateTime.MinValue.Value, fi.CreationTime)
dr("Accessed") = IIf(fi.LastAccessTime < SqlTypes.SqlDateTime.MinValue.Value, SqlTypes.SqlDateTime.MinValue.Value, fi.LastAccessTime)
dt_FS.Rows.Add(dr)
fs_count += 1
' Note: There is no List_ACLs part for files (same as dir_only flag
' in List_ACLs)
f_count += 1
Catch ex As Exception
dr = dt_FS.NewRow
dr("Server") = server
dr("Path") = Left(fi.FullName, 4000)
dr("Name") = Left("Error: " & ex.Message, 260)
dt_FS.Rows.Add(dr)
Console.Write("!")
err_count += 1
' not fatal
End Try
Next
' Let's keep the memory footprint down...
If dt_FS.Rows.Count > My.Settings.RowBuffer Then
Console.Write("*")
db.UpdateTable(dt_FS)
dt_FS.Clear()
End If
If dt_ACL.Rows.Count > My.Settings.RowBuffer Then
Console.Write("*")
db.UpdateTable(dt_ACL)
dt_ACL.Clear()
End If
' Note: dt_SID is never very large... so no need to process it in chunks
' Check directories for errors
Try
di_array = p_di.GetDirectories
Catch ex As Exception
' This probably redundant, since we catch this type of
' error above while processing files.
dr = dt_FS.NewRow
dr("Server") = server
dr("Path") = Left(StartingDir, 4000)
dr("Name") = Left("Error: " & ex.Message, 260)
dt_FS.Rows.Add(dr)
Console.Write("!")
err_count += 1
Exit Sub
End Try
' Process directories (and descend into the dir structure)
For Each di In di_array
Try
' keep 'em entertained
If (d_count Mod 100) = 0 Then
Console.Write(".")
End If
' The FS_Dump part...
dr = dt_FS.NewRow
dr("Server") = server
dr("Path") = Left(di.FullName, 4000)
dr("Name") = di.Name
dr("Ext") = di.Extension.ToLower
dr("FSize") = 0
If owner Then
sid = CType(di.GetAccessControl.GetOwner(GetType(SecurityIdentifier)), SecurityIdentifier)
dr("Owner") = Left(TranslateSID.TranslateSidToName(server, sid), 128)
End If
dr("Attrib") = DoAttrib(di.Attributes)
dr("Modified") = IIf(di.LastWriteTime < SqlTypes.SqlDateTime.MinValue.Value, SqlTypes.SqlDateTime.MinValue.Value, di.LastWriteTime)
dr("Created") = IIf(di.CreationTime < SqlTypes.SqlDateTime.MinValue.Value, SqlTypes.SqlDateTime.MinValue.Value, di.CreationTime)
dr("Accessed") = IIf(di.LastAccessTime < SqlTypes.SqlDateTime.MinValue.Value, SqlTypes.SqlDateTime.MinValue.Value, di.LastAccessTime)
dt_FS.Rows.Add(dr)
fs_count += 1
' The List_ACLs part...
fsar = di.GetAccessControl.GetAccessRules(True, True, GetType(SecurityIdentifier))
' let's see if this DACL is different from the DACL of the current directory
isDifferent = False
If consolidate Then
If fsar.Count <> LastDACL.Count Then
isDifferent = True
End If
' dang, OK... we'll have to check each entry
If Not isDifferent Then
i = 0
For Each ar As FileSystemAccessRule In fsar
If ar.Equals(LastDACL(i)) Then
isDifferent = True
Exit For
End If
i += 1
Next
End If
End If
If Not consolidate Or isDifferent Then
For Each ar As FileSystemAccessRule In fsar
dr = dt_ACL.NewRow
dr("Server") = server
dr("Path") = Left(di.FullName, 4000)
dr("Type") = ar.AccessControlType.ToString
dr("Name") = TranslateSID.TranslateSidToName(server, CType(ar.IdentityReference, SecurityIdentifier))
dr("Permissions") = DirectoryMaskToString(ar.FileSystemRights)
dr("Inherited") = ar.IsInherited
dr("Scope") = ACEFlagToString(ar.InheritanceFlags, ar.PropagationFlags, ar.IsInherited)
dt_ACL.Rows.Add(dr)
acl_count += 1
Next
End If
d_count += 1
Catch ex As Exception
dr = dt_FS.NewRow
dr("Server") = server
dr("Path") = Left(di.FullName, 4000)
dr("Name") = Left("Error: " & ex.Message, 260)
dt_FS.Rows.Add(dr)
Console.Write("!")
err_count += 1
' not fatal
End Try
' recursive call to this subroutine
Doit(di.FullName)
Next
End Sub
'
' User friendly version of the access masks designed to read just like
' the permissions "tab" when looking at the properties of a file inside
' the Windows Explorer
'
Function FileMaskToString(ByVal mask As FileSystemRights) As String
Dim sb As New System.Text.StringBuilder
Select Case mask
Case FileSystemRights.FullControl
Return ("Full Control")
Case FileSystemRights.Modify
Return ("Modify")
Case FileSystemRights.ReadAndExecute
Return ("Read & Execute")
Case FileSystemRights.ExecuteFile
Return ("Execute")
Case FileSystemRights.Read
Return ("Read")
Case FileSystemRights.Write
Return ("Write")
' generic permissions
Case CType(AccessTypes.GENERIC_ALL, FileSystemRights)
Return ("Generic Full Control")
Case CType(AccessTypes.GENERIC_READ Or AccessTypes.GENERIC_WRITE Or AccessTypes.GENERIC_EXECUTE Or AccessTypes.DELETE, FileSystemRights)
Return ("Generic Modify")
Case CType(AccessTypes.GENERIC_READ Or AccessTypes.GENERIC_EXECUTE, FileSystemRights)
Return ("Generic Read & Execute")
Case CType(AccessTypes.GENERIC_EXECUTE, FileSystemRights)
Return ("Generic Execute")
Case CType(AccessTypes.GENERIC_READ, FileSystemRights)
Return ("Generic Read")
Case CType(AccessTypes.GENERIC_WRITE, FileSystemRights)
Return ("Generic Write")
Case Else
' ok... do it the hard way (in bit order)
sb.Append("Special (0x")
sb.Append(Hex(mask))
sb.Append("): ")
If CBool(mask And CType(AccessTypes.GENERIC_READ, FileSystemRights)) Then
sb.Append("Generic Read,")
End If
If CBool(mask And CType(AccessTypes.GENERIC_WRITE, FileSystemRights)) Then
sb.Append("Generic Write,")
End If
If CBool(mask And CType(AccessTypes.GENERIC_EXECUTE, FileSystemRights)) Then
sb.Append("Generic Execute,")
End If
If CBool(mask And CType(AccessTypes.GENERIC_ALL, FileSystemRights)) Then
sb.Append("Generic Full,")
End If
If CBool(mask And CType(AccessTypes.ACCESS_SYSTEM_SECURITY, FileSystemRights)) Then
sb.Append("System,")
End If
If CBool(mask And FileSystemRights.Synchronize) Then
sb.Append("Sync,")
End If
If CBool(mask And FileSystemRights.TakeOwnership) Then
sb.Append("Ownership,")
End If
If CBool(mask And FileSystemRights.ChangePermissions) Then
sb.Append("Change Perm,")
End If
If CBool(mask And FileSystemRights.ReadPermissions) Then
sb.Append("Read Perm,")
End If
If CBool(mask And FileSystemRights.Delete) Then
sb.Append("Delete,")
End If
If CBool(mask And FileSystemRights.WriteAttributes) Then
sb.Append("Write Attr,")
End If
If CBool(mask And FileSystemRights.ReadAttributes) Then
sb.Append("Read Attr,")
End If
If CBool(mask And FileSystemRights.ExecuteFile) Then
sb.Append("Execute,")
End If
If CBool(mask And FileSystemRights.WriteExtendedAttributes) Then
sb.Append("Write ExtAttr,")
End If
If CBool(mask And FileSystemRights.ReadExtendedAttributes) Then
sb.Append("Read ExtAttr,")
End If
If CBool(mask And FileSystemRights.AppendData) Then
sb.Append("Append,")
End If
If CBool(mask And FileSystemRights.WriteData) Then
sb.Append("Write,")
End If
If CBool(mask And FileSystemRights.ReadData) Then
sb.Append("Read,")
End If
Return Left(sb.ToString.TrimEnd(","c), 255)
End Select
End Function
'
' Same as above, but with slightly different wording
'
Function DirectoryMaskToString(ByVal mask As FileSystemRights) As String
Dim sb As New System.Text.StringBuilder
Select Case mask
Case FileSystemRights.FullControl
Return ("Full Control")
Case FileSystemRights.Modify
Return ("Modify")
Case FileSystemRights.ReadAndExecute
Return ("Read & Execute")
Case FileSystemRights.ListDirectory
Return ("List Folder Contents")
Case FileSystemRights.Read
Return ("Read")
Case FileSystemRights.Write
Return ("Write")
' generic permissions
Case CType(AccessTypes.GENERIC_ALL, FileSystemRights)
Return ("Generic Full Control")
Case CType(AccessTypes.GENERIC_READ Or AccessTypes.GENERIC_WRITE Or AccessTypes.GENERIC_EXECUTE Or AccessTypes.DELETE, FileSystemRights)
Return ("Generic Modify")
Case CType(AccessTypes.GENERIC_READ Or AccessTypes.GENERIC_EXECUTE, FileSystemRights)
Return ("Generic Read & Execute")
Case CType(AccessTypes.GENERIC_EXECUTE, FileSystemRights)
Return ("Generic List Folder Contents")
Case CType(AccessTypes.GENERIC_READ, FileSystemRights)
Return ("Generic Read")
Case CType(AccessTypes.GENERIC_WRITE, FileSystemRights)
Return ("Generic Write")
Case Else
' ok... do it the hard way (in bit order)
sb.Append("Special (0x")
sb.Append(Hex(mask))
sb.Append("): ")
If CBool(mask And CType(AccessTypes.GENERIC_READ, FileSystemRights)) Then
sb.Append("Generic Read,")
End If
If CBool(mask And CType(AccessTypes.GENERIC_WRITE, FileSystemRights)) Then
sb.Append("Generic Write,")
End If
If CBool(mask And CType(AccessTypes.GENERIC_EXECUTE, FileSystemRights)) Then
sb.Append("Generic List,")
End If
If CBool(mask And CType(AccessTypes.GENERIC_ALL, FileSystemRights)) Then
sb.Append("Generic Full,")
End If
If CBool(mask And CType(AccessTypes.ACCESS_SYSTEM_SECURITY, FileSystemRights)) Then
sb.Append("System,")
End If
If CBool(mask And FileSystemRights.Synchronize) Then
sb.Append("Sync,")
End If
If CBool(mask And FileSystemRights.TakeOwnership) Then
sb.Append("Ownership,")
End If
If CBool(mask And FileSystemRights.ChangePermissions) Then
sb.Append("Change Perm,")
End If
If CBool(mask And FileSystemRights.ReadPermissions) Then
sb.Append("Read Perm,")
End If
If CBool(mask And FileSystemRights.Delete) Then
sb.Append("Delete,")
End If
If CBool(mask And FileSystemRights.WriteAttributes) Then
sb.Append("Write Attr,")
End If
If CBool(mask And FileSystemRights.ReadAttributes) Then
sb.Append("Read Attr,")
End If
If CBool(mask And FileSystemRights.DeleteSubdirectoriesAndFiles) Then
sb.Append("Delete Folders,")
End If
If CBool(mask And FileSystemRights.Traverse) Then
sb.Append("Traverse,")
End If
If CBool(mask And FileSystemRights.WriteExtendedAttributes) Then
sb.Append("Write ExtAttr,")
End If
If CBool(mask And FileSystemRights.ReadExtendedAttributes) Then
sb.Append("Read ExtAttr,")
End If
If CBool(mask And FileSystemRights.CreateDirectories) Then
sb.Append("Create Folders,")
End If
If CBool(mask And FileSystemRights.CreateFiles) Then
sb.Append("Create Files,")
End If
If CBool(mask And FileSystemRights.ListDirectory) Then
sb.Append("List,")
End If
Return Left(sb.ToString.TrimEnd(","c), 255)
End Select
End Function
'
' A User Friendly version of the "Apply To" column
'
Function ACEFlagToString(ByVal inherit As InheritanceFlags, ByVal propagate As PropagationFlags, ByVal isInherited As Boolean) As String
Dim flag As AceFlags
Dim sb As New System.Text.StringBuilder
' let's reconstitue the ACE_Flag (without the INHERITED_ACE)
flag = 0
If CBool(inherit And InheritanceFlags.ContainerInherit) Then
flag = flag Or AceFlags.CONTAINER_INHERIT_ACE
End If
If CBool(inherit And InheritanceFlags.ObjectInherit) Then
flag = flag Or AceFlags.OBJECT_INHERIT_ACE
End If
If CBool(propagate And PropagationFlags.InheritOnly) Then
flag = flag Or AceFlags.INHERIT_ONLY_ACE
End If
If CBool(propagate And PropagationFlags.NoPropagateInherit) Then
flag = flag Or AceFlags.NO_PROPAGATE_INHERIT_ACE
End If
Select Case flag
Case 0
Return "This folder only"
Case AceFlags.CONTAINER_INHERIT_ACE Or AceFlags.OBJECT_INHERIT_ACE
Return "This folder, subfolders and files"
Case AceFlags.CONTAINER_INHERIT_ACE
Return "This folder and subfolders"
Case AceFlags.OBJECT_INHERIT_ACE
Return "This folder and files"
Case AceFlags.CONTAINER_INHERIT_ACE Or AceFlags.OBJECT_INHERIT_ACE Or AceFlags.INHERIT_ONLY_ACE
Return "Subfolders and files only"
Case AceFlags.CONTAINER_INHERIT_ACE Or AceFlags.INHERIT_ONLY_ACE
Return "Subfolders only"
Case AceFlags.OBJECT_INHERIT_ACE Or AceFlags.INHERIT_ONLY_ACE
Return "Files only"
Case Else
' ok... do it the hard way (in bit order)
' Add INHERITED_ACE back in so the bit mask is correct
If isInherited Then
flag = flag Or AceFlags.INHERITED_ACE
End If
sb.Append("Special (0x")
sb.Append(Hex(flag))
sb.Append("): ")
If CBool(flag And AceFlags.INHERITED_ACE) Then
sb.Append("Inherited")
End If
If CBool(flag And AceFlags.INHERIT_ONLY_ACE) Then
sb.Append("Inherit Only,")
End If
If CBool(flag And AceFlags.INHERIT_ONLY_ACE) Then
' there are already too many people in the world :)
sb.Append("No Propagate,")
End If
If CBool(flag And AceFlags.CONTAINER_INHERIT_ACE) Then
sb.Append("Container,")
End If
If CBool(flag And AceFlags.OBJECT_INHERIT_ACE) Then
sb.Append("Object,")
End If
Return Left(sb.ToString.TrimEnd(","c), 128)
End Select
End Function
'
' Convert the attributes to the one-letter equivalents
'
Private Function DoAttrib(ByVal attr As FileAttributes) As String
Dim sb As New System.Text.StringBuilder
If CInt(attr) = -1 Then
Return "Error"
End If
If (attr And FileAttributes.Archive) <> 0 Then
sb.Append("a")
End If
If (attr And FileAttributes.Compressed) <> 0 Then
sb.Append("c")
End If
If (attr And FileAttributes.Device) <> 0 Then
sb.Append("D")
End If
If (attr And FileAttributes.Directory) <> 0 Then
sb.Append("d")
End If
If (attr And FileAttributes.Encrypted) <> 0 Then
sb.Append("e")
End If
If (attr And FileAttributes.Hidden) <> 0 Then
sb.Append("h")
End If
If (attr And FileAttributes.Normal) <> 0 Then
sb.Append("n")
End If
If (attr And FileAttributes.NotContentIndexed) <> 0 Then
sb.Append("I")
End If
If (attr And FileAttributes.Offline) <> 0 Then
sb.Append("O")
End If
If (attr And FileAttributes.ReadOnly) <> 0 Then
sb.Append("r")
End If
If (attr And FileAttributes.ReparsePoint) <> 0 Then
sb.Append("P")
End If
If (attr And FileAttributes.SparseFile) <> 0 Then
sb.Append("S")
End If
If (attr And FileAttributes.System) <> 0 Then
sb.Append("s")
End If
If (attr And FileAttributes.Temporary) <> 0 Then
sb.Append("T")
End If
Return sb.ToString
End Function
End Module