Leaderboard

What i don't need are snide remarks like this.

I don't think RTFM is the right way to say it. But I trust you make a mental note to check the documentation another time. I mean, the way the message was delivered was clumsy, but the thrust of the message is valid.

I have a collection of Syslog and Windows Event Log Utilities. All 100% developed in Delphi. http://www.allthingssyslog.com/ They are intended for use in testing. Unfortunately I can't put links to the actual tool pages as the site is a single page React Web Application at the moment. Will convert to ASP .Net when I get hosting sorted out. There is a menu in the top right corner of the page which is easy enough to navigate. Go to the Downloads to access the following: 1) The Simulator. This allows you to send test messages to your Syslog server, Log Management system or whatever. Messages can be edited, sent on demand, sent in repeating batches etc. 2) The Windows Event Log Converter. This utility will read entries in a Windows Event Log and forward them to a Syslog Server. There is also a YouTube channel with tutorials on using these utilities here: https://www.youtube.com/channel/UCg97aUZMTKlqMNA_Qxc8wWA Most recently I updated the UIs to make them multi lingual. I just hope google translate didn't give me the German/French/Italian/Dutch equivalent of Engrish. Go to the Utilities page for some extra stuff 1) A basic test Syslog Receiver. It takes messages on UDP and dumps them to a file. Noting special, not even good performance, but useful for demoing basic principles in videos. 2) A Windows Event Log Writer. Works pretty much the same as the simulator, but instead of sending messages to a Syslog receiver, It dumps them in a local Event Log. Using batches it can write up to 12k logs/sec into a Windows Even Log. I originally started writing this stuff to do dev testing on a log management system, but the company was never interested in building out a serious testing architecture. After I left I kept working on them. I still find them useful on occasion, maybe others will too.

I updated the GitHub repo with your changes and am running two more day-long tests (win32+win64) both with 1,000 threads and 20ms pop-timeout on Windows 10 physical machine. My last 24-hour Win32 stress test completed without failure. https://github.com/ideasawakened/DelphiKB/commits/master/Delphi Tests/Source/rtl/common/System.Generics.Collections/TThreadedQueue/StressTestPopItem

Conclusion: It doesn't matter whether I use Breadth First or Depth First Search, the performance is the same. Switching from SysUtils.FindFirst/FindNext to Windows.FindFirstFileEx/FindNextFile with only basic file information and the flag FIND_FIRST_EX_LARGE_FETCH brought me a performance gain of about 25% which is not too bad. I found no way to benefit from using TDirectory. The only test I made got worse performance than FindFirst/Next. Test environment: Windows 8.1 client accessing a share on a Samba server over 1 GBit Ethernet with minimal traffic (it's a weekend). The computer is a reasonably fast Intel Xeon E3 with 3.4 GHz with 8 cores and 16 GByte RAM. The Server has an Intel Core I9-9940X processor with 16 cores and with 64 GBytes of RAM. The share is stored on a 2 TB Intel M2 NVMe SSD. It's running Ubuntu 18.04.4 LTS and Samba 4.7.6-Ubuntu. The test program was compiled with Delphi 10.4. There was a no noticable difference between building with Debug and Release config. The directory tree is 4 levels deep and contains only a few directories on the first 3 levels but a total of 898 directories on the deepest level. Each of these directories on the deepest level contain from several hundred up to several thousand jpeg files. The purpose of the code is to find all directories on any level containing at least one jpeg file but no subdirectories. All tests were run several times in varying order to prevent any caching effects to distort the result.

As promised, here the BFS version using FindFirstFileEx. And as expected, it also takes about 45 seconds in my test setup. function FindFirstFileEx(lpFileName: LPWSTR; fInfoLevelId: TFindexInfoLevels; lpFindFileData: Pointer; fSearchOp: TFindexSearchOps; lpSearchFilter: PWin32FindData; dwAdditionalFlags: DWORD): THandle; stdcall; external kernelbase Name 'FindFirstFileExW'; function FindNextFile(hFindFile: THandle; lpFindFileData: PWin32FindData): BOOL; stdcall; external kernelbase Name 'FindNextFileW'; procedure TForm1.b_FindFirstExNextBFSClick(Sender: TObject); var DirsWithJpg: TArray<string>; DirsToSearch: TStringList; procedure CheckDirectory(const _Dir: string); const FIND_FIRST_EX_LARGE_FETCH = 2; var DirBs: string; SearchHandle: THandle; sr: TWin32FindData; ContainsFiles: boolean; ContainsSubdirs: boolean; fn: string; begin ContainsFiles := False; ContainsSubdirs := False; DirBs := IncludeTrailingPathDelimiter(_Dir); SearchHandle := FindFirstFileEx(PChar(DirBs + '*.*'), FindExInfoBasic, @sr, FindExSearchNameMatch, nil, FIND_FIRST_EX_LARGE_FETCH); if SearchHandle <> INVALID_HANDLE_VALUE then begin try repeat fn := sr.cFileName; if (fn = '.') or (fn = '..') then begin // ignore end else if (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0 then begin // directory ContainsSubdirs := true; // add to list for later processing DirsToSearch.Add(DirBs + fn); end else if sr.dwFileAttributes and (FILE_ATTRIBUTE_HIDDEN or FILE_ATTRIBUTE_SYSTEM or FILE_ATTRIBUTE_REPARSE_POINT) = 0 then begin // regular file if not ContainsFiles then begin if SameText(ExtractFileExt(fn), '.jpg') then begin ContainsFiles := true; end; end; end else begin // ignore special files end; until not FindNextFile(SearchHandle, @sr); finally Winapi.Windows.FindClose(SearchHandle); end; end; if ContainsFiles then begin if ContainsSubdirs then begin m_Result.Lines.Add(Format('Directory %s contains files and subdirectories, ignoring it.', [_Dir])); end else begin DirsWithJpg := DirsWithJpg + [_Dir]; end; end; end; var Stopwatch: TStopwatch; begin Stopwatch.Reset; Stopwatch.Start; DirsToSearch := TStringList.Create; try DirsToSearch.Add('\\server\share\dir'); while DirsToSearch.count > 0 do begin CheckDirectory(DirsToSearch[0]); DirsToSearch.Delete(0); end; finally FreeAndNil(DirsToSearch); end; Stopwatch.Stop; m_Result.Lines.Add(Format('FindFirstExNext BFS: Found %d dirs in %.3f seconds', [Length(DirsWithJpg), Stopwatch.Elapsed.TotalSeconds])); end;

OK, so here is the DFS implementation using FindFirstFileEx and only getting basic info. In my tests on the same computer and with the same Samba server and share it only takes about 45 seconds (rather than the 60 seconds with SysUtils.FindFirst). The result is the same. For completeness I am going to implement BFS for this too, but I don't expect any change really. function FindFirstFileEx(lpFileName: LPWSTR; fInfoLevelId: TFindexInfoLevels; lpFindFileData: Pointer; fSearchOp: TFindexSearchOps; lpSearchFilter: PWin32FindData; dwAdditionalFlags: DWORD): THandle; stdcall; external kernelbase Name 'FindFirstFileExW'; function FindNextFile(hFindFile: THandle; lpFindFileData: PWin32FindData): BOOL; stdcall; external kernelbase Name 'FindNextFileW'; procedure TForm1.b_FindFirstExNextDFSClick(Sender: TObject); var DirsWithJpg: TArray<string>; procedure CheckDirectory(const _Dir: string); const FIND_FIRST_EX_LARGE_FETCH = 2; var DirBs: string; SearchHandle: THandle; sr: TWin32FindData; ContainsFiles: boolean; ContainsSubdirs: boolean; fn: string; begin ContainsFiles := False; ContainsSubdirs := False; DirBs := IncludeTrailingPathDelimiter(_Dir); SearchHandle := FindFirstFileEx(PChar(DirBs + '*.*'), FindExInfoBasic, @sr, FindExSearchNameMatch, nil, FIND_FIRST_EX_LARGE_FETCH); if SearchHandle <> INVALID_HANDLE_VALUE then begin try repeat fn := sr.cFileName; if (fn = '.') or (fn = '..') then begin // ignore end else if (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0 then begin // directory ContainsSubdirs := true; // recursive Depth First Search CheckDirectory(DirBs + fn); end else if sr.dwFileAttributes and (FILE_ATTRIBUTE_HIDDEN or FILE_ATTRIBUTE_SYSTEM or FILE_ATTRIBUTE_REPARSE_POINT) = 0 then begin // regular file if not ContainsFiles then begin if SameText(ExtractFileExt(fn), '.jpg') then begin ContainsFiles := true; end; end; end else begin // ignore special files end; until not FindNextFile(SearchHandle, @sr); finally Winapi.Windows.FindClose(SearchHandle); end; end; if ContainsFiles then begin if ContainsSubdirs then begin m_Result.Lines.Add(Format('Directory %s contains files and subdirectories, ignoring it.', [_Dir])); end else begin DirsWithJpg := DirsWithJpg + [_Dir]; end; end; end; var Stopwatch: TStopwatch; begin Stopwatch.Reset; Stopwatch.Start; CheckDirectory('\\server\share\dir); Stopwatch.Stop; m_Result.Lines.Add(Format('FindFirstExNext DFS: Found %d dirs in %.3f seconds', [Length(DirsWithJpg), Stopwatch.Elapsed.TotalSeconds])); end; I redeclared FindFirstFileEx and FindNextFile for this because the declarations in WinApi.Windows are inconsistent in the declaration of the lpfFindFileData parameter. Now both declare it as PWin32FindData.

My tests show no performance difference at all between DFS und BFS using FindFirst/FindNext. Both take nearly exactly 60 seconds on my test machine traversing the same directory tree on a Samba server. Trying to use TDirectory did not result in any improvement. It takes about twice as long. DFS code: var DirsWithJpg: TArray<string>; procedure CheckDirectory(const _Dir: string); var DirBs: string; sr: TSearchRec; ContainsFiles: boolean; ContainsSubdirs: boolean; begin ContainsFiles := False; ContainsSubdirs := False; DirBs := IncludeTrailingPathDelimiter(_Dir); if FindFirst(DirBs + '*.*', faAnyFile, sr) = 0 then begin try repeat if (sr.Name = '.') or (sr.Name = '..') then begin // ignore end else if (sr.Attr and faDirectory) <> 0 then begin // directory ContainsSubdirs := true; // recursive Depth First Search CheckDirectory(DirBs + sr.Name); end else if sr.Attr and (faHidden or faSysFile or faSymLink) = 0 then begin // regular file if not ContainsFiles then begin if SameText(ExtractFileExt(sr.Name), '.jpg') then begin ContainsFiles := true; end; end; end else begin // ignore special files end; until FindNext(sr) <> 0; finally FindClose(sr); end; end; if ContainsFiles then begin if ContainsSubdirs then begin m_Result.Lines.Add(Format('Directory %s contains files and subdirectories, ignoring it.', [_Dir])); end else begin DirsWithJpg := DirsWithJpg + [_Dir]; end; end; end; var Stopwatch: TStopwatch; begin Stopwatch.Reset; Stopwatch.Start; CheckDirectory('\\server\share\dir'); Stopwatch.Stop; m_Result.Lines.Add(Format('FindFirst/Next DBF: Found %d dirs in %.3f seconds', [Length(DirsWithJpg), Stopwatch.Elapsed.TotalSeconds])); end; BFS code: var DirsWithJpg: TArray<string>; DirsToSearch: TStringList; procedure CheckDirectory(const _Dir: string); var DirBs: string; sr: TSearchRec; ContainsFiles: boolean; ContainsSubdirs: boolean; begin ContainsFiles := False; ContainsSubdirs := False; DirBs := IncludeTrailingPathDelimiter(_Dir); if FindFirst(DirBs + '*.*', faAnyFile, sr) = 0 then begin try repeat if (sr.Name = '.') or (sr.Name = '..') then begin // ignore end else if (sr.Attr and faDirectory) <> 0 then begin // directory ContainsSubdirs := true; // add to list for later processing DirsToSearch.Add(DirBs + sr.Name); end else if sr.Attr and (faHidden or faSysFile or faSymLink) = 0 then begin // regular file if not ContainsFiles then begin if SameText(ExtractFileExt(sr.Name), '.jpg') then begin ContainsFiles := true; end; end; end else begin // ignore special files end; until FindNext(sr) <> 0; finally FindClose(sr); end; end; if ContainsFiles then begin if ContainsSubdirs then begin m_Result.Lines.Add(Format('Directory %s contains files and subdirectories, ignoring it.', [_Dir])); end else begin DirsWithJpg := DirsWithJpg + [_Dir]; end; end; end; var Stopwatch: TStopwatch; begin Stopwatch.Reset; Stopwatch.Start; DirsToSearch := TStringList.Create; try DirsToSearch.Add('\\server\share\dir'); while DirsToSearch.count > 0 do begin CheckDirectory(DirsToSearch[0]); DirsToSearch.Delete(0); end; finally FreeAndNil(DirsToSearch); end; Stopwatch.Stop; m_Result.Lines.Add(Format('FindFirst/Next BFS: Found %d dirs in %.3f seconds', [Length(DirsWithJpg), Stopwatch.Elapsed.TotalSeconds])); end; The naive approach using TDirectory takes about twice as long because of the calls to .GetFiles and .GetDirectories each call FindFirst/FindNext per directory. (It also finds 2 less directories containing jpg files, so there is probably a bug somewhere, but I didn't investigate this any further.) var DirsWithJpg: TArray<string>; procedure CheckDirectory(const _Dir: string); var Files: TArray<string>; Dirs: TArray<string>; i: Integer; begin Files := TDirectory.GetFiles(_Dir, '*.jpg'); Dirs := TDirectory.GetDirectories(_Dir); if Length(Files) > 0 then begin if Length(Dirs) > 0 then begin m_Result.Lines.Add(Format('Directory %s contains files and subdirectories, ignoring it.', [_Dir])); end else DirsWithJpg := DirsWithJpg + [_Dir]; end else begin for i := Low(Dirs) to High(Dirs) do CheckDirectory(Dirs[i]); end; end; var Stopwatch: TStopwatch; begin Stopwatch.Reset; Stopwatch.Start; CheckDirectory('\\server\share\dir'); Stopwatch.Stop; m_Result.Lines.Add(Format('DirGetFiles: Found %d dirs in %.3f seconds', [Length(DirsWithJpg), Stopwatch.Elapsed.TotalSeconds])); end; I thought about using TDirectory.FileSystemEntries instead but could not think of a simple way to implement this. It's probably possible using a Predicate but that's not really any simpler than directly using FindFirst/FindNext. There is probably still some space for improvements and the code is not really clean, e.g. accessing variables of the outer procedure. So, now I'll have a look at calling Windows.FindFirstFileEx instead of FindFirst, but I don't have much hope that this will help much.

I always do Stopwatch := TStopwatch.StartNew; On a side note I wonder if the new managed records thing could make your original one work (which I would prefer.)

I commented this in another thread, but it doesn't hurt to repeat it. When you find a problem with RAD Studio, make sure to create a report in https://quality.embarcadero.com And - please describe the problem properly! What you are trying to do The actual result you got The result you expected Most important: How to reproduce the problem - either as a detailed step by step description - or as a small, self-contained, compilable example project - or both of the above Better reports = better chance of getting stuff fixed.

Thanks, Lars. I did not know that quality.embarcadero.com was still extant. I will take a few days now, working through piece by piece, until I find what causes this problem. It will take time! (I have put 10.3.3 back on the system, and it runs itself and the programme fine! However, I was impressed by 10.4 finding a couple of bugs which don't show up in 10.3.3, so you have some people doing great work there!)

You are right about that but they can fix TMonitor (the ABA problem) by using a private, correct implementation of InterlockedCompareExchange128 without breaking DCU compatibility. They could also just implement a temporary fix for InterlockedCompareExchange128 that maintains the incorrect return type (bool) but returns the correct value.