Directory Tree demonstrates how to list all subdirectories under a directory. Simply specify the "root" directory and output file.
This can be useful, for example, when writing a program that searches for files.
Printable View
Directory Tree demonstrates how to list all subdirectories under a directory. Simply specify the "root" directory and output file.
This can be useful, for example, when writing a program that searches for files.
Significantly faster method, is to request directories only, not all files.Quote:
Originally Posted by Peter Swinkels
Hence the line...
should read.Code:Item = Dir$("*.*", vbArchive Or vbDirectory Or vbHidden Or vbSystem)
Difference in performance, is very significant - typically minutes, when there is large amount of directories and files within these.Code:Item = Dir$("*.", vbArchive Or vbDirectory Or vbHidden Or vbSystem)
Note that the underlying APIs (FindFirstFile, etc.) will still enumerate files matching the specified pattern whether they are wanted or not. ;)Quote:
Originally Posted by Tech99
Thanks for the replies,
Tech99: thanks for the suggestion. Why did you omit the last wild card (*. instead of *.*)? Directory names do sometimes have an extension.
Bonnie West:
Does this mean it doesn't really matter?
Any way,
Writing code, especially like this, is always balancing between readabilty and simplicity. Directly using the API probably would be fastest.
Too bad if the situation is that kind. Slows down substantially.Quote:
Originally Posted by Peter Swinkels
We have instructed not to use '.' in directory names, in our file handling applications. Otherwise performance in file systems containing over 10k folders, would be very sluggish - as you are enumerating files also, usually tens of thousands to at least few hundred thousand.
Are you sure about that. Performance differs very very much between *.* vs. *. calls.Quote:
Originally Posted by Bonnie West
Since my program is meant as a generic demonstration, I tried not to exclude anything for the sake of speed. If people feel they could use my code, they're perfectly free to make any changes they like, for whatever reason. So I'm probably going to leave the code "as is" for now. But I also understand your point about having to make certain sacrifices (such as omitting directory's with extensions in their name) in order to keep things fast.Quote:
Originally Posted by Tech99
Thanks for the comments.
I fully understand that, and believe that others do also. However my point in this subject is to clarify subject where 'wrong coding' easily leads to 'unusable application'*. Been there done that.Quote:
Originally Posted by Peter Swinkels
*Poor performance when files and folders count is largish.
For the better performance one might use FindFirstFileEx API using FindExInfoBasic and FIND_FIRST_EX_LARGE_FETCH flags.
Even better perfomance is achieved using NtQueryDirectoryFile API.
aaand... best performance is achieved by using either of the previous methods and ditching NT as a file server altogether and using fex. RHE Linux and Samba shares = two to three fold better in file system performance.**
** or in NT case, code a system driver which reads and parses MFT, then entire disk folders- and files names can be read in within few seconds - regardless of folder and file count.
Quote:
Originally Posted by Peter Swinkels
According to the documentation, FindFirstFile "searches a directory for a file or subdirectory with a name that matches a specific name (or partial name if wildcards are used)."Quote:
Originally Posted by Tech99
What that means is that the search pattern cannot guarantee that only files or only folders will be found. Files & folders can both have dot (.) characters in their names and it is also perfectly possible for both of them to not have any dot characters in their names.
Here's an example. Consider a directory that contains these files & folders:
New Folder
New.Folder
New Text Document txt
New Text Document.txt
The *.* search pattern would match all 4 of those files & folders. The *. search pattern, OTOH, would match New Folder and New Text Document txt.
So, as you can see, it isn't possible to instruct FindFirstFile to return files only or folders only. Performance differs of course because files usually have extension names and excluding them from the search will indeed result in a much faster directory listing.
Yes i know, i should have been more specific in description.Quote:
Originally Posted by Bonnie West
Now when you request folders using *.* the api function returns all files and folders. Very large amount of items in worst case, then when you request folder names using *. only the file count drops substantially and performance is much better - of course, after Findfile - one should filter out files using directory flag comparison.
We typically have customer systems thousands of folders, where file count easily exceeds 20k, that makes significant difference and is easily handled limiting/prohibiting using dot in folder names.
Code:'part of...
Sub RecurseFolder (ByRef pstrFolder As String)
Dim lngHandle As Long
Dim strFile As String
Dim typFind As WIN32_FIND_DATA
If Right$(pstrFolder, 1) = "\" Then pstrFolder = Left$(pstrFolder, Len(pstrFolder) - 1)
lngHandle = FindFirstFile(pstrFolder & "\*.", typFind)
Do While lngHandle <> INVALID_HANDLE_VALUE
strFile = Left$(typFind.cFileName, InStr(typFind.cFileName, vbNullChar) - 1)
If (typFind.dwFileAttributes And vbDirectory) = vbDirectory Then
If Left$(strFile, 1) <> "." Then
RecurseFolder pstrFolder & "\" & strFile
Here is very fast enumerator (EnumFolders.zip)
http://www.vbforums.com/showthread.p...=1#post4936619
On the contrary. Poor performance, when only folder names needs to enumerate... but little change makes it perform. Altought this version could not use '*.' notation, hence slower than method above.Quote:
Originally Posted by pekko
However i am planning to write enumeration class using ntQueryFileDirectory, which should be bit faster, expecially in network shares.
Code:Public Sub EnumFolders(ByVal sPath As String, _
Optional ByVal sPattern As String = "*.*", _
Optional ByVal lAttributeFilter As FileAttributes = Attr_ALL, _
Optional ByVal bRecurse As Boolean = True)
Dim lHandle As Long
Dim sName As String
Dim Lines As Long
Dim lPtr As Long
lPtr = VarPtr(wFD)
On Error GoTo ProcedureError
sPath = QualifyPath(sPath)
lHandle = FindFirstFileW(StrPtr("\\?\" & sPath & sPattern), lPtr)
If lHandle > 0 Then
Do
With wFD
sName = TrimNull(.cFileName)
If (.dwFileAttributes And vbDirectory) Then
If bRecurse Then
If AscW(sName) <> vbDot Then 'skip . and .. entries
1. added RaiseEvent ItemDetails(sPath, sName) 'Added line
EnumFolders sPath & sName, sPattern, lAttributeFilter, bRecurse
End If
End If
2. comm 'ElseIf (.dwFileAttributes And lAttributeFilter) Then 'Commented out
3. ented out 'RaiseEvent ItemDetails(sPath, sName) 'Commented out
End If
End With
Loop While FindNextFileW(lHandle, lPtr) > 0
End If
FindClose lHandle
Exit Sub
ProcedureError:
Debug.Print "Error " & Err.Number & " " & Err.Description & " of EnumFolders"
End Sub
I actually did some comparisons of the codes in that thread back then but I hesitated to post them because the OP no longer seems interested. I've posted them now, in case somebody else is interested those codes.Quote:
Originally Posted by pekko
@ Tech99
You may want to give this reworked version of my code in that thread a try.
Do you mean Enumfolders Modifed sample?Quote:
Originally Posted by Bonnie West
http://www.vbforums.com/attachment.p...5&d=1447745715
That is slow, because it does not enumerate folders only, but also files. Tested it against my code to one file share.
116 folders share. Enumfolders modified took around 16 seconds and true folders only enumeration took sub one second.
17418 folders, with over half million files share. Enumfolders modified took around 13 minutes and true folders only enumeration took about 2.3 second.
This version (List folders.zip post #13 in this thread) performance is acceptable, 17418 folders, took about 7.3 second.Quote:
Originally Posted by Bonnie West
Difference to my code, comes mainly from listing folders, when in my version folders are only read to array.
So the *.* vs *. do really matter. It would be interesting to see how NtQueryDirectoryFile would perform.
Here is Bonney West last submitted version (List folders.zip post #13 in this thread) a bit optimized -> half second better performance per 10k path count.
Modifiation to the mnuBrowse_Click() subroutine (add three lines).
Replace whole ListFolders subroutine, with this code.Code:ListFolders sPath, "*." '<-- The "*." pattern fails to list folder names such as "New.Folder"
'ListFolders sPath, "*.*" '<--The "*.*" pattern is bit slower, but would find folder names such as New.Folder"
'Add these next three lines to the mnuBrowse_Click() subroutine
For i = LBound(dirNames) To UBound(dirNames)
SendMessage m_hWndLB, LB_ADDSTRING, 0&, StrPtr(dirNames(i))
Next i
Add to module or form level.Code:Private Sub ListFolders(ByRef FolderPath As String, Optional ByRef Pattern As String = "*")
'NOTE!!! FolderPath should not end in a trailing backslash (\)
Const ALLOC_CHUNK = 10&
Dim hFindFile As Long
Dim i As Long
Dim Length As Long
Dim SubFolder As String
Static lCount As Long
hFindFile = FindFirstFile(FolderPath & "\" & Pattern, m_WFD)
If hFindFile <> INVALID_HANDLE_VALUE Then
Do 'Process folders only (junctions, symlinks & mounted folders won't be recursed)
If (m_WFD.dwFileAttributes And (FILE_ATTRIBUTE_DIRECTORY Or FILE_ATTRIBUTE_REPARSE_POINT)) And Asc(m_WFD.cFileName) <> vbDot Then
Length = lstrlen(m_WFD.cFileName)
SubFolder = Left$(m_WFD.cFileName, Length)
lCount = lCount + 1
ReDim Preserve dirNames(lCount) As String
dirNames(lCount) = FolderPath & ("\" & SubFolder & "\")
ListFolders FolderPath & ("\" & SubFolder), Pattern 'Recurse subfolders
End If
Loop While FindNextFile(hFindFile, m_WFD)
hFindFile = FindClose(hFindFile): Debug.Assert hFindFile
End If
End Sub
Code:Private Const vbDot = 46
Dim dirNames() As String
No, I was referring to the attachment in my post.Quote:
Originally Posted by Tech99
Yes, the search pattern greatly influences indeed the amount of file and folder names that FindFirstFile will return. However, note that the *. pattern does not filter out names such as ".Folder" or "..File". ;)Quote:
Originally Posted by Tech99
In the original code:Quote:
Originally Posted by Tech99
the highlighted part served to ensure that only regular folders were processed. Junctions, symbolic links and mounted folders all have the FILE_ATTRIBUTE_REPARSE_POINT flag set, so in order to skip them, the expression must include the highlighted portion above.Code:If (m_WFD.dwFileAttributes And (FILE_ATTRIBUTE_DIRECTORY Or FILE_ATTRIBUTE_REPARSE_POINT)) = FILE_ATTRIBUTE_DIRECTORY Then
Regarding the testing of the "." and ".." entries, code that utilizes the Asc(W) function fails to take into account file & folder names that begins with the dot character. Such names (which are more like extension-only names) are legal and are actually not really that rare (at least in my system).
Yes, so i thought also, just asking for.Quote:
Originally Posted by Bonnie West
Sure we know that - however one must bear in mind that most files do have an extension and folders do not - at least when prohibited to use dot when naming folders, so that - in well doumented and instructed to userland - does significant difference.Quote:
Yes, the search pattern greatly influences indeed the amount of file and folder names that FindFirstFile will return. However, note that the *. pattern does not filter out names such as ".Folder" or "..File". ;)
...and when your search pattern is nailed to '*.' user does not find incorrectly named folders (if using explorer etc. 'standard' tooling to create/rename), so that '*.' steers them very effectively to follow rules. :)
Yes, that also is by purpose/design.Quote:
Regarding the testing of the "." and ".." entries, code that utilizes the Asc(W) function fails to take into account file & folder names that begins with the dot character. Such names (which are more like extension-only names) are legal and are actually not really that rare (at least in my system).
So what is the difference in short circuiting that to...Quote:
Originally Posted by Bonnie West
Evaluates to True also, so the expression does not need to include the highlighted portion above.Code:If (m_WFD.dwFileAttributes And (FILE_ATTRIBUTE_DIRECTORY Or FILE_ATTRIBUTE_REPARSE_POINT))
That expression is checking for both FILE_ATTRIBUTE_DIRECTORY and FILE_ATTRIBUTE_REPARSE_POINT bit flags. (If we neglect to check for FILE_ATTRIBUTE_REPARSE_POINT, we could possibly recurse into a junction, symbolic link or mounted folder and we normally don't want to do that [theoretically, infinite recursion could happen].) In order for the test to succeed, only the FILE_ATTRIBUTE_DIRECTORY bit must be set (if FILE_ATTRIBUTE_REPARSE_POINT is also set, then the entire expression evaluates to False). That is the purpose of the equality test at the end.Quote:
Originally Posted by Tech99
BTW, most of the folder names in my system that either contains or begins with the dot character weren't created by me. Programs such as GIMP, Java, Pale Moon, Notepad++ and even Windows itself (see e.g. the winsxs folder) all created folders that contained dot characters without my intervention. IMO, if one is going to write a generic directory walker code that uses FindFirstFile & co., details like dot characters in folder names and the possibility of encountering junctions, symbolic links and mounted folders must be taken into account.
Ok, i see - excellent point, so i stand corrected.
Directory evaluation corrected:
As what comes to hard/soft/symbolic links or junctions - it seems that there is none, other than those Windows OS generated ones (All Users, Application Data, Documents etc.).Code:'dot is not allowed in directory names
If (m_WFD.dwFileAttributes And (FILE_ATTRIBUTE_DIRECTORY Or FILE_ATTRIBUTE_REPARSE_POINT)) = FILE_ATTRIBUTE_DIRECTORY And (Asc(m_WFD.cFileName) <> vbDot) Then
Users typically are not creating/defining those, neither do engineering or other apps we use. Briefly checked and did not find dot containing folder names from Notepad++ or Gimp installations, Java nor Pale Moon browser we don't even run.
Here is my unicode class. In my example fill a RTB with all folders from C.
Class do some nice things and is extracted from M2000 Interpreter (the I use it to fill a user control, a special list box that can be show folders and files in a form of tree).
In a form only these lines are enough to get all folders along the path. Because list can hold files too, we have to use mid$() to skip the folder marker. So if you make NoFiles as False you get the files too.
Code:Dim md As New recDir
Private Sub Form_Load()
Dim a$, i As Long, k As Long
RichTextBox1 = ""
md.Nofiles = True
a$ = md.Dir2("C:\", , True)
Me.Caption = md.listcount
k = 1
For i = 1 To md.listcount
RichTextBox1.SelStart = k
a$ = Trim$(Str$(i)) + " " + Mid$(md.List(i), 2) + vbCrLf
k = k + Len(a$)
RichTextBox1.SelText = a$
Next i
End Sub
Attachment 132389
Replace the form code from previous example, and you can use with Events the recDir class. You can stop the searching by using the close button on window.
Code:Dim WithEvents md As recDir, working As Boolean, getout As Boolean
Dim k As Long, i As Long
Private Sub Form_Load()
Set md = New recDir
Dim a$, i As Long, k As Long
k = 1
Show
working = True
RichTextBox1 = ""
md.Nofiles = True
laststr = "C:\"
a$ = md.Dir2("C:\", , True)
End Sub
Private Sub Form_Resize()
If Me.ScaleHeight > 1000 And Me.ScaleWidth > 1000 Then
RichTextBox1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End If
End Sub
Private Sub Form_Terminate()
Set md = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
md.abort = True
If working Then Cancel = True: getout = True
End Sub
Private Sub md_DirFinished()
working = False
If getout Then
Unload Me
Else
Me.Caption = md.listcount
MsgBox "finished"
End If
End Sub
Private Sub md_feedback(FileName As String)
RichTextBox1.SelStart = k
i = i + 1
'a$ = Trim$(Str$(i)) + Space$(md.ReadLevel(md.listcount - 1) + 1) + FileName + vbCrLf
a$ = Trim$(Str$(i)) + md.FindFolder(md.listcount - 1) + Mid$(FileName, 2) + vbCrLf
k = k + Len(a$)
RichTextBox1.SelText = a$
End Sub
Tested this, same path than previous tests, expect that users have greated 6 folders more (17418 vs. 17424).Quote:
Originally Posted by georgekar
Takes quite considerable amount of time (over minute) and little bit more memory than versions above.
Yeah, junctions and symbolic links are generally underused in Windows. Mounted folders, however, might be slightly more common.Quote:
Originally Posted by Tech99
Quote:
Originally Posted by Tech99
- GIMP created ".gimp-2.8" and ".thumbnails" folders under my user profile folder.
- Java created "jre1.8.0_51" and "jre1.8.0_60" folders under its installation directory.
- Pale Moon (and most likely other FireFox based browsers) created 2 "*.default" folders under the 2 "Profiles" folder in the "AppData" directory.
- Notepad++ created a "user.manual" folder under its installation directory.
- Finally, and I don't know how this got into my system, Microsoft (?) created a "Microsoft.NET" folder in the "Program Files" directory.
The point Peter Swinkels and I are trying make is that the "*." pattern is not a totally fool-proof way of filtering out files and returning folders only. Even if your users were told to avoid using the dot character in their folder names, some programs may just be out of your control. FindFirstFile et al. are probably not the best choice for you if you require both rapid searching and folders-only enumeration.
Tech99 ,
Using this line you can add spaces but not the full path
a$ = Trim$(Str$(i)) + Space$(md.ReadLevel(md.listcount - 1) + 1) + FileName + vbCrLf
As you see for each full path need a search in the list. So the right job is to show the folders, using the level and when the user click on a folder then one time he get the search.
The think about the use of a level and only a name is for the minimum need to store information. We don't have to repeat each path in each line. So you get the minute because using md.FindFolder(md.listcount - 1) in each line add more time to final loop.
If you see the class recDir there is method to define a stop level (say 3 sub folders), and you can select the sorting method
In my code in my sign you find my M2000 Interpreter. There I have a control I made using this class (In the demo above I put a small function that leaves in a module in M2000). The control show a directory, or a tree of files and can search in the background using the code asynchronously. And if you see you can break the search at any time. But if you see the code there is a Doevents in the code that is calling using a MOD operator. So if you change the number of Doevents that occur, the rate of that, you get a faster or slower search.
Another way to use RecDir class is by using it to fill internal array once :
Code:Sub testme(p$, tp$)
Dim md As New recDir, offset As Long
offset = Len(p$) + 1
md.LevelStop = 1
md.SortType = 2 ' change that
a$ = md.Dir2(p$, tp$)
Do
a$ = md.Dir2()
If a$ <> "" Then Debug.Print a$ Else Exit Do
Loop
md.Nofiles = True
a$ = md.Dir2(p$)
Do
a$ = md.Dir2()
If a$ <> "" Then Debug.Print Mid$(a$, offset) Else Exit Do
Loop
End Sub
You didn't read my post at all?
So i clarify my point of view once more. We don't care if application creates it's own dotted folder names (for thumbnails or whatever) - those folders are not project data folders under data folder tree created by project people ie. where engineers, designers, accoutants etc. store their work files.
Like Bonnie already said you can not say you should not use "." in folder names and ignore folders which do have "." in their name.
This should be a generic code submission.
So others can use it as a template and adapt it to their needs.
I did, and I believe I understood every word you wrote pretty well.Quote:
Originally Posted by Tech99
The only reason why I joined this thread was because you stated in your post #2:Quote:
Originally Posted by Tech99
Since my post #3, I have been trying to point out to you that that method works well only in your particular case. Other programmers, especially "those junior coders", who will come to this thread in the future might get the impression that it's OK to use the "*." pattern if all they want to enumerate are folders only. Well, it is not, as my demonstrations above have shown.Quote:
Originally Posted by Tech99
You mentioned above that you were planning on writing an enumeration class using NtQueryDirectoryFile. I'm not familiar with that API, but if it has the capability to enumerate folders only (and do it quickly), then there is probably no more reason to forbid your users from using the dot character in folder names.
Not sure about that yet, but NtQuery is fastest method to filesystem driver.Quote:
Originally Posted by Bonnie West
For the directory only enumeration there is FindFirstFileEx API, found out that in yesterday, when studying this matter. To modify your sample to use EX version.
Difference in performance is about one second per 1.2K folders, when pattern is '*.' and bit more than that when pattern is '*.*'.Code:'Add to declaration section
Private Enum FINDEX_INFO_LEVELS
FindExInfoStandard = 0&
FindExInfoBasic = 1& 'supported in W7 and newer
FindExInfoMaxInfoLevel = 2&
End Enum
Private Enum FINDEX_SEARCH_OPS
FindExSearchNameMatch = 0&
FindExSearchLimitToDirectories = 1&
FindExSearchLimitToDevices = 2&
FindExSearchMaxSearchOp = 3&
End Enum
Private Const FIND_FIRST_EX_LARGE_FETCH = 2
Private Declare Function FindFirstFileEx Lib "kernel32.dll" Alias "FindFirstFileExA" (ByVal lpFileName As String, _
ByVal FindExInfoLevel As FINDEX_INFO_LEVELS, lpFindFileData As WIN32_FIND_DATA, ByVal FindExSearchOp As FINDEX_SEARCH_OPS, lpSearchFilter As Any, ByVal dwAdditionalFlags As Long) As Long
'Change FindFirstFile call to FindFirstFileEx call in Private Sub ListFolders.
'hFindFile = FindFirstFile(FolderPath & "\" & Pattern, m_WFD)
hFindFile = FindFirstFileEx(FolderPath & "\" & Pattern, FINDEX_INFO_LEVELS.FindExInfoBasic, m_WFD, FINDEX_SEARCH_OPS.FindExSearchLimitToDirectories, 0&, 0&)
Now the '*.*' pattern performs quite well in large filesystems.
If your program is only being used in NT-based OSs, then you can improve the performance some more by just simply replacing all ANSI APIs with their Unicode counterparts. Of course, that means you'll either need to use StrPtr() when passing Strings or you'll have to set a reference to a type library where the Unicode APIs are declared.Quote:
Originally Posted by Tech99
Quote:
Originally Posted by MSDN
Yeah i know and that is the one problem, customer base has, among the others older (4 and even 3.51) NT machines. 'The story' they telling goes - no need to change os, because those versions work. Couple of customers even run Wine.Quote:
Originally Posted by Bonnie West
Bonnie West
I provide a unicode solution above, with sorting routine. You can alter to match your needs..Works with events also. Just tell me if you see it.
One scenario with FindFirstFileEx API which needs to measure, came to my mind. Enabling FIND_FIRST_EX_LARGE_FETCH flag and trying with search pattern '*'. Performance could be even better, if that kind of call would automatically recurse subfolders.
hFindFile = FindFirstFileEx(FolderPath & "\" & Pattern, FINDEX_INFO_LEVELS.FindExInfoBasic, m_WFD, FINDEX_SEARCH_OPS.FindExSearchLimitToDirectories, 0&, FIND_FIRST_EX_LARGE_FETCH)
Edit, tested performance, bit mixed results. Windows 7 workstation benefited enabling FIND_FIRST_EX_LARGE_FETCH flag and setting pattern to '*'. Server search did not, actually it was bit slower than querying without large fetch flag.
W7 workstation, 1285 folders
pattern *.* -> 6.8731, 6.9714 and 6.8767 seconds.
Pattern * and Large_Fetch -> 5.3779, 5.4598, 5.5258 seconds.
W12K R2 server, 19459 folders
Pattern *.* -> 3.1201, 3.1146, 3.1199 seconds.
Pattern * and Large_Fetch -> 3.2430, 3.2397, 3.2519 seconds.
W12K R2 server, via share 17434 folders
Pattern *.* -> 26.1318, 26.5813, 26.5810 seconds.
Pattern * and Large_Fetch -> 24.6481, 24.5381, 24.5071 seconds.
Interesting that server machine performs lesser when FIND_FIRST_EX_LARGE_FETCH flag is enabled.
btw... adding 19459 folders to listbox took 9.5 seconds (mean).
Quite a suprise is that the SMB perfomance is so much lesser (cpu Xeon E5 2620 v3 with 12 cores, 40 Gb memory, 4 x gigabit network, Smart Array P440ar controller), tuning tips are welcome. :)
Increase AdditionalWorkerThreads or what to try/do?
https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx
https://redmondmag.com/articles/2014...-problems.aspx
https://technet.microsoft.com/en-us/.../jj134210.aspx
Thanks, georgekar! Yeah, I've already seen your attachment in post #22. I hope you don't mind, but I favor a different approach when it comes to optimizing directory enumeration. I prefer to do things as directly as possible so that intermediate "steps" such as Events are skipped.Quote:
Originally Posted by georgekar
More faster (more than 3 times faster)
Attachment 132457
I do an optimization. Before I had a general IsDir() function, But now because I have "data" for attribute I know when I have folder. Secondly I put in raiseevent the foldername and all folders.
Check the code above.
I think that you possibly were measuring cached performance. Tested noncached performance, it took 72 seconds - so 5 second progress to previous version.Quote:
Originally Posted by georgekar
Tech99
There is a huge directory in windows 7, C:\Windows\winsxs with 6808 folders and 6800 of them with many dots in name. if you exclude that folders then you gain time, but you have miss a lot....
And what you mean noncached performance...Does Windows cache all directories of C:\
No, i didn't test against C:\ folder, but the same data folder structure used in other previous tests, so there were no dots in directory names. Windows somewhat caches ie. when you read folder structure second time, time taken drops - so to get true measurement this must be dealt - either flush cahce or disable caching altogether when testing.Quote:
Originally Posted by georgekar
https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx
To enumerate directories.
Use FindFirstFileEx with FindExInfoBasic and FindExSearchLimitToDirectories parameters, there is no other way to get decent performance without going to lower level API's.
Also little performance increase might be achieved using FIND_FIRST_EX_LARGE_FETCH flag, but this seems to be bit contradictory.
Code:hSearch = FindFirstFileEx(sPath & "*", FINDEX_INFO_LEVELS.FindExInfoBasic, WFD, FINDEX_SEARCH_OPS.FindExSearchLimitToDirectories, 0&, 0&)
or
hSearch = FindFirstFileEx(sPath & "*", FINDEX_INFO_LEVELS.FindExInfoBasic, WFD, FINDEX_SEARCH_OPS.FindExSearchLimitToDirectories, 0&, FIND_FIRST_EX_LARGE_FETCH)
Are there any VB6 samples of either of these approaches? I'd be very interested in these.Quote:
Originally Posted by Tech99
Found this:
http://www.fenlog.com/?mod=wap&act=View&id=16
Basically it implements FindFirstFile/FindNextFile in VB6 using the NtQueryDirectoryFile API. Cool stuff.
Here's a cleaned up version without all the chinese
I'm just not sure how to limit it to directories only yet (apart from checking the .FileAttributes and excluding those after the fact.. pDir.FileAttributes And FILE_ATTRIBUTE_DIRECTORY). It's also not recursive so you'd have to implement that no matter what, the API can't do that on its own.Code:Option Explicit
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Type UNICODE_STRING
uLength As Integer
uMaximumLength As Integer
pBuffer As Long
End Type
Private Type IO_STATUS_BLOCK
Status As Long
uInformation As Long
End Type
Private Type OBJECT_ATTRIBUTES
Length As Long
RootDirectory As Long
ObjectName As Long
Attributes As Long
SecurityDescriptor As Long
SecurityQualityOfService As Long
End Type
Private Type FILE_BOTH_DIRECTORY_INFORMATION
NextEntryOffset As Long
FileIndex As Long
CreationTime As LARGE_INTEGER
LastAccessTime As LARGE_INTEGER
LastWriteTime As LARGE_INTEGER
ChangeTime As LARGE_INTEGER
EndOfFile As LARGE_INTEGER
AllocationSize As LARGE_INTEGER
FileAttributes As Long
FileNameLength As Long
EaSize As Long
ShortNameLength As Byte
ShortName(23) As Byte
FileName As Byte
FileName1 As Integer '(519) As Byte
End Type
Private Const FileBothDirectoryInformation = 3
Private Const SYNCHRONIZE = &H100000
Private Const FILE_ANY_ACCESS = 0
Private Const FILE_LIST_DIRECTORY = 1
Private Const FILE_DIRECTORY_FILE = 1
Private Const FILE_SYNCHRONOUS_IO_NONALERT = &H20
Private Const FILE_OPEN_FOR_BACKUP_INTENT = &H4000
Private Const OBJ_CASE_INSENSITIVE = &H40
Private Declare Function NtQueryDirectoryFile Lib "ntdll.dll" (ByVal FileHandle As Long, _
ByVal hEvent As Long, _
ByVal ApcRoutine As Long, _
ByVal ApcContext As Long, _
ByRef IoStatusBlock As Any, _
FileInformation As Any, _
ByVal Length As Long, _
ByVal FileInformationClass As Long, _
ByVal ReturnSingleEntry As Long, _
FileName As Any, _
ByVal RestartScan As Long) As Long
Private Declare Function NtClose Lib "ntdll.dll" (ByVal ObjectHandle As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function NtOpenFile Lib "ntdll.dll" (FileHandle As Long, _
ByVal DesiredAccess As Long, _
ObjectAttributes As OBJECT_ATTRIBUTES, _
IoStatusBlock As IO_STATUS_BLOCK, _
ByVal ShareAccess As Long, _
ByVal OpenOptions As Long) As Long
Private Declare Sub RtlInitUnicodeString Lib "ntdll.dll" (DestinationString As Any, ByVal SourceString As Long)
Private Declare Sub ZeroMemory Lib "ntdll.dll" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
Private Function FindFirstFile(ByVal strDirectory As String, bytBuffer() As Byte) As Long
Dim strFolder As String
Dim obAttr As OBJECT_ATTRIBUTES
Dim objIoStatus As IO_STATUS_BLOCK
Dim ntStatus As Long
Dim hFind As Long
Dim strUnicode As UNICODE_STRING
strFolder = "\??\"
strFolder = strFolder & strDirectory
RtlInitUnicodeString strUnicode, StrPtr(strFolder)
obAttr.Length = LenB(obAttr)
obAttr.Attributes = OBJ_CASE_INSENSITIVE
obAttr.ObjectName = VarPtr(strUnicode)
obAttr.RootDirectory = 0
obAttr.SecurityDescriptor = 0
obAttr.SecurityQualityOfService = 0
ntStatus = NtOpenFile(hFind, _
FILE_LIST_DIRECTORY Or SYNCHRONIZE Or FILE_ANY_ACCESS, _
obAttr, _
objIoStatus, _
3, _
FILE_DIRECTORY_FILE Or FILE_SYNCHRONOUS_IO_NONALERT Or FILE_OPEN_FOR_BACKUP_INTENT)
If ntStatus = 0 And hFind <> -1 Then
ntStatus = NtQueryDirectoryFile(hFind, _
0, _
0, _
0, _
objIoStatus, _
bytBuffer(0), _
UBound(bytBuffer), _
FileBothDirectoryInformation, _
1, _
ByVal 0&, _
0)
If ntStatus = 0 Then
FindFirstFile = hFind
Else
NtClose hFind
End If
End If
End Function
Private Function FindNextFile(ByVal hFind As Long, bytBuffer() As Byte) As Boolean
Dim ntStatus As Long
Dim objIoStatus As IO_STATUS_BLOCK
ntStatus = NtQueryDirectoryFile(hFind, _
0, _
0, _
0, _
objIoStatus, _
bytBuffer(0), _
UBound(bytBuffer), _
FileBothDirectoryInformation, _
0, _
ByVal 0&, _
0)
If ntStatus = 0 Then
FindNextFile = True
Else
FindNextFile = False
End If
End Function
Private Sub cmdEnum_Click()
Dim pDir As FILE_BOTH_DIRECTORY_INFORMATION
Dim hFind As Long
Dim bytBuffer() As Byte
Dim bytName() As Byte
Dim strPath As String
Dim strFileName As String * 520
Dim dwFileNameOffset As Long
Dim dwDirOffset As Long
Me.lstFile.Clear
ReDim bytBuffer(LenB(pDir) + 260 * 2 - 3)
strPath = txtPath.Text
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
hFind = FindFirstFile(strPath, bytBuffer) '»ñÈ¡µÚÒ»¸öÎļþ/Ŀ¼¶ÔÏó
CopyMemory pDir, bytBuffer(0), LenB(pDir)
ReDim bytName(pDir.FileNameLength - 1)
dwFileNameOffset = VarPtr(bytBuffer(&H5E))
CopyMemory bytName(0), ByVal dwFileNameOffset, pDir.FileNameLength
strFileName = strPath & CStr(bytName)
Me.lstFile.AddItem strFileName
Erase bytBuffer
ReDim bytBuffer((LenB(pDir) + CLng(260 * 2 - 3)) * CLng(&H2000))
If FindNextFile(hFind, bytBuffer) Then
dwDirOffset = 0
Do While 1
ZeroMemory pDir, LenB(pDir)
CopyMemory pDir, ByVal VarPtr(bytBuffer(dwDirOffset)), LenB(pDir)
Erase bytName
ReDim bytName(pDir.FileNameLength - 1)
dwFileNameOffset = dwDirOffset + &H5E
dwFileNameOffset = VarPtr(bytBuffer(dwFileNameOffset))
CopyMemory bytName(0), ByVal dwFileNameOffset, pDir.FileNameLength
strFileName = strPath & CStr(bytName)
Me.lstFile.AddItem strFileName
If pDir.NextEntryOffset = 0 Then Exit Do
dwDirOffset = dwDirOffset + pDir.NextEntryOffset
Loop
End If
NtClose hFind
Me.lblMsg.Caption = "Count: " & Me.lstFile.ListCount
End Sub
Awesome - thanks for posting this! I'm going to do some timings to see how it compares with what I'm currently using: FindFirstFileExW with FindExInfoBasicInfoLevel and FIND_FIRST_EX_LARGE_FETCH.Quote:
Originally Posted by fafalone
Well initial performance results are very good! NTQueryDirectoryFile() is indeed quite a bit faster than Find First/NextFileEx. This is not surprising seeing that the Find APIs call NTQueryDirectoryFile from all of the documentation I've come across.Quote:
Originally Posted by AAraya
However, I am not getting correct results when enumerating a folder on my backup drive (a MyBook Live). The file and folder counts are off. The local drive works great however. At first I thought it was to the UNC path spec so I mapped a drive to it and used the drive letter, but this actually made the problem WORSE! Searched all over the net for an explanation for this but there's just not a lot of documentation on this undocumented function let alone much in VB for it.
If I can't find a solution to get this to work on all drives, I'm going to have to stick to the Find APIs.
Another issue I'm having is with paths in UNC notation (\\server\share\folder\). I prepend the "\??\" required by NtOpenFile which results in a path of "\??\\\server\share\folder\" but when passed to NtOpenFile I get an NT Status code of STATUS_OBJECT_NAME_INVALID. No problems with paths in mapped drive notation. UNC paths must require a different treatment but good luck trying to find this information anywhere.
It's just the count that is off? Or are there actually files/folders missing?
It adds a ".." and "." to the list that aren't files, so the count is off by 2 for that
I've seen a few network share examples for NtOpenFile... they all say it should be \\??\\UNC\\server\share and when I use that, the function returns a success, but then things later crash because it says there's a filename but .FileNameLength is 0, so it throws 'subscript out of range' when trying to ReDim the buffer. The path pointed to isn't empty.
Edit: So on another note, I've made it recursive. There were a few complications because it returns "." and ".." as folders, and nulls weren't being trimmed from the buffer.
Edit2: I'm not sure if it makes a difference in terms of performance, but I also went on to change it to return FILE_DIRECTORY_INFORMATION instead of FILE_BOTH_DIR_INFORMATION, which doesn't retrieve the short name. Doing this also helps in understanding the code better; first the NtQuery API needs to be told to retrieve the other struct instead;Code:Private Sub DoSearch(strPath As String)
'Debug.Print "DoSearch(" & strPath & ")"
Dim pDir As FILE_BOTH_DIRECTORY_INFORMATION
Dim hFind As Long
Dim bytBuffer() As Byte
Dim bytName() As Byte
Dim strFileName As String * 520
Dim dwFileNameOffset As Long
Dim dwDirOffset As Long
Dim sTrimmed As String
ReDim bytBuffer(LenB(pDir) + 260 * 2 - 3)
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
hFind = FindFirstFile(strPath, bytBuffer)
CopyMemory pDir, bytBuffer(0), LenB(pDir) '»ñÈ¡FILE_BOTH_DIRECTORY_INFORMATION½á¹¹£¬Ä¿µÄÊÇ»ñÈ¡FileNameLengthºÍNextEntryOffsetÊý¾Ý
ReDim bytName(pDir.FileNameLength - 1)
dwFileNameOffset = VarPtr(bytBuffer(&H5E))
CopyMemory bytName(0), ByVal dwFileNameOffset, pDir.FileNameLength
strFileName = strPath & CStr(bytName)
' Me.lstFile.AddItem strFileName
Erase bytBuffer
ReDim bytBuffer((LenB(pDir) + CLng(260 * 2 - 3)) * CLng(&H2000))
If FindNextFile(hFind, bytBuffer) Then
dwDirOffset = 0
Do While 1
ZeroMemory pDir, LenB(pDir) '°ÑFILE_BOTH_DIRECTORY_INFORMATIONÖÃ0
CopyMemory pDir, ByVal VarPtr(bytBuffer(dwDirOffset)), LenB(pDir) 'µÃµ½FILE_BOTH_DIRECTORY_INFORMATION½á¹¹
Erase bytName
ReDim bytName(pDir.FileNameLength - 1)
dwFileNameOffset = dwDirOffset + &H5E
dwFileNameOffset = VarPtr(bytBuffer(dwFileNameOffset))
CopyMemory bytName(0), ByVal dwFileNameOffset, pDir.FileNameLength
strFileName = strPath & CStr(bytName)
If pDir.FileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
sTrimmed = Left$(strFileName, Len(strPath) + (pDir.FileNameLength / 2))
If (sTrimmed <> (strPath & ".")) And (sTrimmed <> (strPath & "..")) Then
Me.lstFile.AddItem sTrimmed
DoSearch sTrimmed
End If
End If
If pDir.NextEntryOffset = 0 Then Exit Do
dwDirOffset = dwDirOffset + pDir.NextEntryOffset
Loop
End If
NtClose hFind
End Sub
FileDirectoryInformation is used instead of FileBothDirectoryInformation, with the struct:Code:Private Const FileDirectoryInformation = 1
Private Const FileFullDirectoryInformation = 2
Private Const FileBothDirectoryInformation = 3
I've noted the byte offset of the filename here, because of this code:Code:Private Type FILE_DIRECTORY_INFORMATION
NextEntryOffset As Long
FileIndex As Long
CreationTime As LARGE_INTEGER
LastAccessTime As LARGE_INTEGER
LastWriteTime As LARGE_INTEGER
ChangeTime As LARGE_INTEGER
EndOfFile As LARGE_INTEGER
AllocationSize As LARGE_INTEGER
FileAttributes As Long
FileNameLength As Long
FileName1 As Integer 'OFFSET=&H40 (64)
End Type
dwFileNameOffset = VarPtr(bytBuffer(&H40)) 'It was &H5E, which is the filename offset in FILE_BOTH_DIRECTORY_INFORMATION
[...]
dwFileNameOffset = dwDirOffset + &H40 'This also needs to be changed from &H5E[/tt]
The same technique can also be used to return any other supported value for the FileInformationClass parameter (see https://msdn.microsoft.com/en-us/lib...=vs.85%29.aspx). If you're not limiting to folders so don't need attributes, and don't need timestamps, you can even use FileNamesInformation, which returns only filenames.
The structures have to be padded to 4 bytes, so
has a (2) padding of 3 bytes instead of just one like the other structure with short name.Code:Private Type FILE_ID_BOTH_DIR_INFORMATION
NextEntryOffset As Long
FileIndex As Long
CreationTime As LARGE_INTEGER
LastAccessTime As LARGE_INTEGER
LastWriteTime As LARGE_INTEGER
ChangeTime As LARGE_INTEGER
EndOfFile As LARGE_INTEGER
AllocationSize As LARGE_INTEGER
FileAttributes As Long
FileNameLength As Long '//64 bytes in standard members
EaSize As Long
ShortNameLength As Byte
ShortName(23) As Byte
FileId As LARGE_INTEGER
FId(2) As Byte 'Padding
FileName1 As Integer '//OFFSET=104 &H68
End Type
The FileID isn't particularly useful in VB though. You can convert to Currency, but can't shift the last 4 digits to the left of the decimal, and you can't print it as Hex$() without overflowing
Files and folders are missing from the enumeration of the remote drive\folder! Weird right?Quote:
Originally Posted by fafalone
In terms of naming, I have come to learn that the Nt functions like NtOpenFile want names in the NT namespace convention whereas I'm working with files that use the Win32 namespace conventions. That's what prepending "\??\" is doing which works for a folder on mapped drive. I need the equivalent for a UNC path. There must be something more elegant than hardcoding it like this however. Surely there exists an API to convert a path from Win32 to Nt namespace? I'm currently looking but haven't found one yet.
Seek and you shall find! My research turned up that the way WinAPIs convert DOS paths to NT paths under the hood is via a call to the RtlDosPathNameToRelativeNtPathName() routine. So I'm on the path to a solution here. I'm not a C guy so coming up with VB6 declares for this is not something within my abilities. I'll see if someone else has already written an example for this in VB6.Quote:
Originally Posted by AAraya
...And NO. Not much code out there for this routine in general.
Is this something one of you Xtreme VB'ers are up to?
I don't think that function is going to help; its output is the "\??\UNC\\Server\share" that I already tried. It returned success but later gave 0-length names.
Dos Path
Full Path
NT Path
\\server\share\ABC\DEF
\\server\share\ABC\DEF
\??\UNC\server\share\ABC\DEF
Hmmm... were you able to write some VB6 code that uses this function and confirm the output? Or are you getting that from the documentation?Quote:
Originally Posted by fafalone
Appreciate your help with this. It's nice to know I'm not beating away at this on my own!
If you want to play around with it, it goes like this:
Public Declare Function RtlDosPathNameToNtPathName_U Lib "ntdll" (ByVal DosFileName As Long, NtFileName As UNICODE_STRING, FilePart As Long, RelativeName As Any) As Boolean
in FindFirstFile
Edit: That replaces the RtlInitUnicodeString call; don't call both.Code:Dim strUnicode As UNICODE_STRING
Dim fp As Long, rn As Long
strFolder = "\??\"
strFolder = strFolder & strDirectory
RtlDosPathNameToNtPathName_U StrPtr(strFolder), strUnicode, fp, rn
The way it's written there results in the same conditions. It works as above for local directories/mapped drives, but not for \\server\share type paths, with or without \??\ prepended.
EDIT-Progress
Are you by chance testing this on shares hosted on the local machine?
I noticed that while it doesn't work for shares on my machine, I *could* use it to list from OTHER machines on my network, using \??\UNC\server\path; using both the original RtlInitUnicodeString way, and the RtlDosPathNameToNtPathName_U way.
And still, ntStatus is always S_OK on the local shares when specified in the exact same format. It seems to give the first folder of ".", then the problem seems to come in FindNextFile, FindNextFile err=0xC000000D STATUS_INVALID_PARAMETER
Edit 2: This may be a bug in this function. Just out of curiosity, I tried the same formatting with the normal CreateFile function.
CreateFile(StrPtr("\??\UNC\server\share"), [...]) works for both other machines AND the local machine, which means there's nothing wrong with the format or paths being passed to NtOpenFile; which confines the problem to that second call to NtQuery..
Nothing I've done seems to help; I've limited the access rights, used NtCreateFile instead, etc, nothing is making that later error go away and there's nothing to adjust in that call.
--------------
PS- While we're working on this, I thought it would be helpful to make a function to get the name of NtStatus codes. There's like 1100 of them though so I'm attaching it. There's also an enum for the values.
Thanks!Quote:
Originally Posted by fafalone
But I'm puzzled. I thought that the RtlDosPathNameToNtPathName() function took a DOS path name and converted it to an NT name. If so, why are you manually prepending it with "\??\"? I thought that this is what the function would do?
One would think so, but for whatever reason that doesn't seem to be the case. Without adding the \??\ NtOpenFile returns 0xC000003B STATUS_OBJECT_PATH_SYNTAX_BAD; even for regular C:\path inputs.
In fact on further examination the function actually fails if passed a normal path and doesn't even seem to do anything. To check its output:
.uLength and .pBuffer both are zero if \??\ isn't there.Code:Dim sTrace As String
sTrace = String$(strUnicode.uLength / 2, 0)
CopyMemory ByVal StrPtr(sTrace), ByVal strUnicode.pBuffer, strUnicode.uLength
Debug.Print "pathtrace=" & sTrace
Side note; that function leaks memory. strUnicode needs to be freed at the end.
Private Declare Sub RtlFreeUnicodeString Lib "ntdll.dll" (UnicodeString As UNICODE_STRING)
I've created my own routine to convert DOS to NT path names. It's pretty simple but maybe it'll help someone else searching for this in the future:
Code:Public Function DosPathNameToNtPathName(pstrDOSPath As String) As String
'//http://googleprojectzero.blogspot.com/2016/02/the-definitive-guide-on-win32-to-nt.html
Dim strPrepend As String
Dim strNTPath As String
If LenB(pstrDOSPath) = 0 Then
strNTPath = ""
GoTo PROC_EXIT
End If
'make sure path has a trailing backslash
Dim strNameWithBackSlash As String
strNameWithBackSlash = AddSlash(pstrDOSPath)
If IsUNCPath(strNameWithBackSlash) Then
'...UNC path
'ex) "\\server\share\ABC\" = "\??\UNC\server\share\ABC\"
strPrepend = "\??\UNC\"
strNTPath = strPrepend & Right$(strNameWithBackSlash, Len(strNameWithBackSlash) - 2)
Else
'...mapped drive
'ex) "C:\Program Files\" = "\??\C:\Program Files\"
strPrepend = "\??\"
strNTPath = strPrepend & strNameWithBackSlash
End If
PROC_EXIT:
DosPathNameToNtPathName = strNTPath
End Function
Code:Public Function IsUNCPath(pstrPath As String) As Boolean
Dim bolIsUNCPath As Boolean
If Len(pstrPath) > 1 Then
If IsSameString(Left$(pstrPath, 2), "\\", vbBinaryCompare) Then
bolIsUNCPath = True
Else
bolIsUNCPath = False
End If
Else
bolIsUNCPath = False
End If
IsUNCPath = bolIsUNCPath
End Function
Quote:
Private Function AddSlash(pstrPath as string) as string
If Right$(pstrPath, 1) <> "\" then
AddSlash = pstrPath & "\"
Else
AddSlash = pstrPath
End If
End Function
Strangely, some changes I just made to my code had an impact on how many files I'm seeing on the remote share. I was seeing about 123 out of 290 files now I'm seeing 164. The only changes on my end were 1) Support for UNC path added (I was using a mapped drive to access the path before), 2) Switch from FILE_BOTH_DIR_INFORMATION to FILE_DIRECTORY_INFORMATION.
If I can't see all files on all drives then NTQueryDirectoryFile is useless to me, no matter how fast it is. What puzzles me is that the Find First/NextFileEx APIs find all of the files and these APIs call the lower level NT routine of NTQueryDirectoryFiles. So why would the higher level routines see all files and not the lower level ones? Is there something else that must be done when calling NTQueryDirectoryFiles, some missing steps or parameters? Or is there a chance that the VB6 code has a bug in it somewhere? But if this was the case why would it work flawlessly on a local hard drive? The NTStatus is reporting STATUS_SUCCESS as far as I can see. I'm not getting any errors.
Bummer, so so close to having this working...
I guess I'm going to try to slog through some code examples in other languages to see if there's something that is missing from the VB6 implementation we're playing around with here.
I noticed a similar problem while using FILE_BOTH_DIR_INFORMATION... it didn't list folders, and it didn't list the last 4 files. But after switching to FILE_DIRECTORY_INFORMATION it showed everything in every remote folder I tried. Did you adjust the offsets in both places?
Just in case you're having a permissions issue, I'd change FILE_ANY_ACCESS to FILE_READ_ACCESS (&H1) so you're not requesting write access.
Try using the same changes I'm using; drop in the following to replace everything in frmMain in the sample project:
That will add all files and folders, recursively, to the list. It will also number things so you can track down what's not showing up if you still have that problem.Code:Option Explicit
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Type UNICODE_STRING
uLength As Integer
uMaximumLength As Integer
pBuffer As Long
End Type
Private Type IO_STATUS_BLOCK
Status As Long
uInformation As Long
End Type
Private Type OBJECT_ATTRIBUTES
Length As Long
RootDirectory As Long
ObjectName As Long
Attributes As Long
SecurityDescriptor As Long
SecurityQualityOfService As Long
End Type
Private Type FILE_BOTH_DIRECTORY_INFORMATION
NextEntryOffset As Long
FileIndex As Long
CreationTime As LARGE_INTEGER '8 bytes
LastAccessTime As LARGE_INTEGER
LastWriteTime As LARGE_INTEGER
ChangeTime As LARGE_INTEGER
EndOfFile As LARGE_INTEGER
AllocationSize As LARGE_INTEGER
FileAttributes As Long
FileNameLength As Long '//64
EaSize As Long
ShortNameLength As Byte
ShortName(23) As Byte
FileName As Byte
FileName1 As Integer '(519) As Byte; OFFSET=&H5E (94 bytes, this is the 95th)
End Type
Private Type FILE_DIRECTORY_INFORMATION
NextEntryOffset As Long
FileIndex As Long
CreationTime As LARGE_INTEGER
LastAccessTime As LARGE_INTEGER
LastWriteTime As LARGE_INTEGER
ChangeTime As LARGE_INTEGER
EndOfFile As LARGE_INTEGER
AllocationSize As LARGE_INTEGER
FileAttributes As Long
FileNameLength As Long
FileName1 As Integer 'OFFSET=&H40 (64)
End Type
Private Type FILE_FULL_DIR_INFORMATION
NextEntryOffset As Long
FileIndex As Long
CreationTime As LARGE_INTEGER
LastAccessTime As LARGE_INTEGER
LastWriteTime As LARGE_INTEGER
ChangeTime As LARGE_INTEGER
EndOfFile As LARGE_INTEGER
AllocationSize As LARGE_INTEGER
FileAttributes As Long
FileNameLength As Long '//64 bytes in standard members
EaSize As Long
FileName1 As Integer 'OFFSET=&H48
End Type
Private Type FILE_ID_BOTH_DIR_INFORMATION
NextEntryOffset As Long
FileIndex As Long
CreationTime As LARGE_INTEGER
LastAccessTime As LARGE_INTEGER
LastWriteTime As LARGE_INTEGER
ChangeTime As LARGE_INTEGER
EndOfFile As LARGE_INTEGER
AllocationSize As LARGE_INTEGER
FileAttributes As Long
FileNameLength As Long '//64 bytes in standard members
EaSize As Long
ShortNameLength As Byte
ShortName(23) As Byte
FileId As LARGE_INTEGER
FId(2) As Byte 'Padding
FileName1 As Integer '//OFFSET=104 &H68
End Type
Private Type FILE_ID_FULL_DIR_INFORMATION
NextEntryOffset As Long
FileIndex As Long
CreationTime As LARGE_INTEGER
LastAccessTime As LARGE_INTEGER
LastWriteTime As LARGE_INTEGER
ChangeTime As LARGE_INTEGER
EndOfFile As LARGE_INTEGER
AllocationSize As LARGE_INTEGER
FileAttributes As Long
FileNameLength As Long '//64 bytes in standard members
EaSize As Long
FileId As LARGE_INTEGER
FileName1 As Integer '//OFFSET=76 &H4C
End Type
Private Type FILE_NAMES_INFORMATION
NextEntryOffset As Long
FileIndex As Long
FileNameLength As Long
FileName1 As Integer '//OFFSET=12 &HC
End Type
'Only the uncommented values can be used with NtQueryDirectoryFile
Private Enum FILE_INFORMATION_CLASS
FileDirectoryInformation = 1
FileFullDirectoryInformation = 2
FileBothDirectoryInformation = 3
FileNamesInformation = 12
FileObjectIdInformation = 29
FileReparsePointInformation = 33
FileIdBothDirectoryInformation = 37
FileIdFullDirectoryInformation = 38
End Enum
Private Const SYNCHRONIZE = &H100000
Private Const FILE_ANY_ACCESS = 0
Private Const FILE_READ_ACCESS = 1
Private Const FILE_LIST_DIRECTORY = 1
Private Const FILE_DIRECTORY_FILE = 1
Private Const FILE_SYNCHRONOUS_IO_NONALERT = &H20
Private Const FILE_OPEN_FOR_BACKUP_INTENT = &H4000
Private Const OBJ_CASE_INSENSITIVE = &H40
Private Const FILE_OPEN = 1
Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ As Long = &H1&
Private Const OPEN_ALWAYS As Long = 4&
Private Const OPEN_EXISTING As Long = 3&
Private Const CREATE_ALWAYS As Long = 2&
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20&
Private Const GENERIC_READ As Long = &H80000000
Private Const FILE_END As Long = 2&
Private Const GENERIC_ALL As Long = &H10000000
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80&
Private Declare Function RtlDosPathNameToNtPathName_U Lib "ntdll" (ByVal DosFileName As Long, NtFileName As UNICODE_STRING, FilePart As Long, RelativeName As Any) As Boolean
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileW" ( _
ByVal lpFileName As Long, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function NtQueryDirectoryFile Lib "ntdll.dll" (ByVal FileHandle As Long, _
ByVal hEvent As Long, _
ByVal ApcRoutine As Long, _
ByVal ApcContext As Long, _
ByRef IoStatusBlock As Any, _
FileInformation As Any, _
ByVal Length As Long, _
ByVal FileInformationClass As FILE_INFORMATION_CLASS, _
ByVal ReturnSingleEntry As Long, _
FileName As Any, _
ByVal RestartScan As Long) As Long
Private Declare Function NtClose Lib "ntdll.dll" (ByVal ObjectHandle As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function NtOpenFile Lib "ntdll.dll" (FileHandle As Long, _
ByVal DesiredAccess As Long, _
ObjectAttributes As OBJECT_ATTRIBUTES, _
IoStatusBlock As IO_STATUS_BLOCK, _
ByVal ShareAccess As Long, _
ByVal OpenOptions As Long) As Long
Private Declare Function NtCreateFile Lib "ntdll.dll" (FileHandle As Long, _
ByVal DesiredAccess As Long, _
ObjectAttributes As OBJECT_ATTRIBUTES, _
IoStatusBlock As IO_STATUS_BLOCK, _
AllocationSize As Any, _
ByVal FileAttributes As Long, _
ByVal ShareAccess As Long, _
ByVal CreateDisposition As Long, _
ByVal CreateOptions As Long, _
ByVal EaBuffer As Any, _
ByVal EaLength As Long) As Long
Private Declare Sub RtlInitUnicodeString Lib "ntdll.dll" (DestinationString As Any, ByVal SourceString As Long)
Private Declare Sub RtlFreeUnicodeString Lib "ntdll.dll" (UnicodeString As UNICODE_STRING)
Private Declare Sub ZeroMemory Lib "ntdll.dll" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
Private Function FindFirstFile(ByVal strDirectory As String, bytBuffer() As Byte) As Long
Dim strFolder As String
Dim obAttr As OBJECT_ATTRIBUTES
Dim objIoStatus As IO_STATUS_BLOCK
Dim NTSTATUS As Long
Dim hFind As Long
Dim strUnicode As UNICODE_STRING
Dim fp As Long, rn As Long
strFolder = "\??\"
strFolder = strFolder & strDirectory
RtlDosPathNameToNtPathName_U StrPtr(strFolder), strUnicode, fp, rn
' RtlInitUnicodeString strUnicode, StrPtr(strFolder)
obAttr.Length = LenB(obAttr)
obAttr.Attributes = OBJ_CASE_INSENSITIVE
obAttr.ObjectName = VarPtr(strUnicode)
obAttr.RootDirectory = 0
obAttr.SecurityDescriptor = 0
obAttr.SecurityQualityOfService = 0
' NTSTATUS = NtCreateFile(hFind, FILE_LIST_DIRECTORY Or SYNCHRONIZE Or FILE_READ_ACCESS, _
' obAttr, objIoStatus, ByVal 0&, 0&, FILE_SHARE_READ, FILE_OPEN, _
' FILE_DIRECTORY_FILE Or FILE_SYNCHRONOUS_IO_NONALERT, ByVal 0&, 0&)
NTSTATUS = NtOpenFile(hFind, _
FILE_LIST_DIRECTORY Or SYNCHRONIZE Or FILE_READ_ACCESS, _
obAttr, _
objIoStatus, _
3, _
FILE_DIRECTORY_FILE Or FILE_SYNCHRONOUS_IO_NONALERT) ' Or FILE_OPEN_FOR_BACKUP_INTENT)
Debug.Print "hFind=" & hFind & ",ntStatus=0x" & Hex$(NTSTATUS) & " " & GetNTStatusStr(NTSTATUS)
Debug.Print "iostatus=0x" & Hex$(objIoStatus.Status) & ",iobytes=" & objIoStatus.uInformation
If NTSTATUS = 0 And hFind <> -1 Then
NTSTATUS = NtQueryDirectoryFile(hFind, _
0, _
0, _
0, _
objIoStatus, _
bytBuffer(0), _
UBound(bytBuffer) + 1, _
FileDirectoryInformation, _
1, _
ByVal 0&, _
0)
If NTSTATUS = 0 Then
FindFirstFile = hFind
Else
Debug.Print "Error2, ntStatus=0x" & Hex$(NTSTATUS) & " " & GetNTStatusStr(NTSTATUS)
NtClose hFind
End If
Else
Debug.Print "Error, ntStatus=0x" & Hex$(NTSTATUS) & " " & GetNTStatusStr(NTSTATUS)
End If
RtlFreeUnicodeString strUnicode
End Function
Private Function FindNextFile(ByVal hFind As Long, bytBuffer() As Byte) As Boolean
Dim NTSTATUS As Long
Dim objIoStatus As IO_STATUS_BLOCK
NTSTATUS = NtQueryDirectoryFile(hFind, _
0, _
0, _
0, _
objIoStatus, _
bytBuffer(0), _
UBound(bytBuffer) + 1, _
FileDirectoryInformation, _
0, _
ByVal 0&, _
0)
If NTSTATUS = 0 Then
FindNextFile = True
Else
Debug.Print "FindNextFile hFind=" & hFind & ",err=0x" & Hex$(NTSTATUS) & " " & GetNTStatusStr(NTSTATUS)
Debug.Print "iostatus=0x" & Hex$(objIoStatus.Status) & ",iobytes=" & objIoStatus.uInformation
FindNextFile = False
End If
End Function
Private Sub cmdEnum_Click()
Dim strPath As String
strPath = txtPath.Text
Me.lstFile.Clear
DoSearch strPath
Me.lblMsg.Caption = "Count=" & Me.lstFile.ListCount
End Sub
Private Sub DoSearch(strPath As String)
Debug.Print "DoSearch(" & strPath & ")"
Dim pDir As FILE_DIRECTORY_INFORMATION
Dim hFind As Long
Dim bytBuffer() As Byte
Dim bytName() As Byte
Dim strFileName As String * 520
Dim dwFileNameOffset As Long
Dim dwDirOffset As Long
Dim sTrimmed As String
Dim i As Long
ReDim bytBuffer(LenB(pDir) + 260 * 2 - 3)
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
hFind = FindFirstFile(strPath, bytBuffer)
If hFind = -1 Then
Debug.Print "hFind=-1, exiting"
Exit Sub
End If
CopyMemory pDir, bytBuffer(0), LenB(pDir)
Debug.Print "initlen=" & pDir.FileNameLength
ReDim bytName(pDir.FileNameLength - 1)
dwFileNameOffset = VarPtr(bytBuffer(&H40))
CopyMemory bytName(0), ByVal dwFileNameOffset, pDir.FileNameLength
strFileName = strPath & CStr(bytName)
Erase bytBuffer
ReDim bytBuffer((LenB(pDir) + CLng(260 * 2 - 3)) * CLng(&H2000))
If FindNextFile(hFind, bytBuffer) Then
dwDirOffset = 0
Do While 1
ZeroMemory pDir, LenB(pDir)
CopyMemory pDir, ByVal VarPtr(bytBuffer(dwDirOffset)), LenB(pDir)
Erase bytName
ReDim bytName(pDir.FileNameLength - 1)
dwFileNameOffset = dwDirOffset + &H40
dwFileNameOffset = VarPtr(bytBuffer(dwFileNameOffset))
CopyMemory bytName(0), ByVal dwFileNameOffset, pDir.FileNameLength
strFileName = strPath & CStr(bytName)
sTrimmed = Left$(strFileName, Len(strPath) + (pDir.FileNameLength / 2))
If (sTrimmed <> (strPath & ".")) And (sTrimmed <> (strPath & "..")) Then
i = i + 1
Me.lstFile.AddItem CStr(i) & ": " & sTrimmed
Debug.Print "file=" & sTrimmed
If pDir.FileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
DoSearch sTrimmed
End If
End If
If pDir.NextEntryOffset = 0 Then Exit Do
dwDirOffset = dwDirOffset + pDir.NextEntryOffset
Loop
End If
NtClose hFind
End Sub
One other thing to consider... is the performance gain from this function so huge it's a significant factor in the latency of listing the contents of a remote system? Something to measure.
Well sadly using your code produced the same results on my remote share. I don't have this problem with the Find First/Next APIs so I'm going to stick with them. I'm very intrigued by the performance gain but obviously can't use NTQueryDirectoryFile if it's missing files. The lack of documentation and examples is also an issue.
Oh well... can't say it's been for naught however. I've learned a bunch working on this. I'm going to take a look at the other NT functions and see if there's anything else in there which I can make use of.
Thanks for your help with this!
That was useful, thanks! I've created another very useful routine for working with NTStatus codes. This one converts an NTStatus code into a more familiar Win32 error code equivalent:Quote:
Originally Posted by fafalone
Code:Private Type OVERLAPPED
Internal As Long
InternalHigh As Long
Offset As Long
OffsetHigh As Long
hEvent As Long
End Type
Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
Private Declare Function GetOverlappedResult Lib "kernel32" (ByVal hFile As Long, lpOverlapped As OVERLAPPED, lpNumberOfBytesTransferred As Long, ByVal bWait As Long) As Long
Public Function ConvertNtStatusToWin32Error(NTStatus As Long) As Long
Dim oldError As Long
Dim result As Long
Dim br As Long
Dim o As OVERLAPPED
With o
.Internal = NTStatus
.InternalHigh = 0
.Offset = 0
.OffsetHigh = 0
.hEvent = 0
End With
oldError = Err.LastDllError() 'don't use GetLastError in VB6. It's not reliable.
Call GetOverlappedResult(0&, o, br, 0&)
result = Err.LastDllError()
SetLastError (oldError)
ConvertNtStatusToWin32Error = result
End Function
<clip>
Just in case you're having a permissions issue, I'd change FILE_ANY_ACCESS to FILE_READ_ACCESS (&H1) so you're not requesting write access.
</clip>
I would use FILE_DIRECTORY_FILE option and FILE_LIST_DIRECTORY access.
Take a look at this C++ code.
http://cboard.cprogramming.com/windo...ctoryfile.html