[Solved] Shell controls sorting rule (CompareText vs. AnsiCompareText)

[d7_2_laz]

I think about for certain use cases to use more the Shell Controls instead of self written  stuff.
Because it's easy, slim and fast to use without much overhead. Nowadays even with builtin system icons ...
Actually i stumble across two things though. One is this small one:

Regarding folders as well as files, differently from common used file explorers / windows items beginning with underbar ("_") are sorted at the end, not at the beginning:
I noticed that because i'm using the underscore oftenly to bring some items in a certain attention:
__savedVersions
_tempStuff
Work1

I'd suggest that the comps follow the established sorting rules, eg. shown by Windows explorer, or others.

On the other hand:
for the shell listview i assume that using the OnCompare callback resp. some customsort rules possibly could customize that on app level-
But: the shell treeview does not expose such an OnCompare, right??
It seems to use "CompareText" and this returns:
CompareText ('a', 'b')    -1  (negative value) 'a' is smaller thand 'b'
CompareText ('_', 'b')    30  (positive value) '_' is greater than 'a'

Rrenark:
AnsiCompareText instead would deliver the desired result. I don't know if it can ssen as a good solution.  but at least it does met the expectation (i tried it with the ShellViewEx demo that was contributed times ago within the forum (fantasic demo!). That uses self-coded "GetFiles" (virtual paradigm, OwnerData) for to gain speed. And it exposes a sort routine that i could adapt and test.

However, AnsiCompareText seems to slowdown the process here, as i could see (nearly doubled speed loss) . A conditional usage of this function does solve that effect sufficiently.

Code: Pascal  [Select][+][-]

1. function Compare(Item1, Item2: Pointer): Integer;
2. var FileData1: PFileData; FileData2: PFileData; S1, S2: String;
3. begin
4.   FileData1 := PFileData(Item1);
5.   FileData2 := PFileData(Item2);
6.   if (FileData1^.FIsDir = FileData2^.FIsDir) then begin
7.         S1 := FileData1^.FName;
8.         S2 := FileData2^.FName;
9.         if ((Pos('_', S1) > 0) Or (Pos('_', S2) > 0)) then
10.            Compare := AnsiCompareText(S1, S2)
11.         else
12.            Compare := CompareText(S1, S2);
13.   end
14.   else
15.     Compare := Ord(FileData2^.FIsDir) - Ord(FileData1^.FIsDir)
16. end;

But how to apply that sort override to the shell treeview?

[d7_2_laz]

For the ShellTreeView, it would work just as expected, if the function FilesSortAlphabet would be changed as:

Code: Pascal  [Select][+][-]

1. function FilesSortAlphabet(p1, p2: Pointer): Integer;
2. var
3.   f1, f2: TFileItem; S1, S2: String;
4. begin
5.   f1:=TFileItem(p1);
6.   f2:=TFileItem(p2);
7.   // Replace:
8.   //Result:=CompareText(f1.FileInfo.Name, f2.FileInfo.Name);
9.   // By:
10.   S1 := f1.FileInfo.Name;
11.   S2 := f2.FileInfo.Name;
12.   if ((Pos('_', S1) > 0) Or (Pos('_', S2) > 0)) then
13.      Result := AnsiCompareText(S1, S2)
14.   else
15.      Result := CompareText(S1, S2);
16. end;
17.  

(when FileSortType is set to  fstAlphabet)

[wp]

i'm using the underscore oftenly to bring some items in a certain attention:
__savedVersions
_tempStuff
Work1

I do that too, and find it very convenient. However, this seems to be windows-only. When I look at these folder from a VM with Linux I see a different sort order in the file managers which simply ignores the underscores (see attachment). So, we must be careful to not change the default order people are accustomed to. Therefore, I am afraid that hacking the FilesSortAlphabet function is not an allowed option.

TShellTreeView has built-in sorting, defined by the FileSortType = (fstNone, fstAlphabet, fstFoldersFirst). For the latter two cases, the files are sorted in the implementation-only procedure GetFilesInDir. This procedure uses an internal TList to store the relevant data of each file in an instance of a TFileItem class containing the SearchRec and the base path. Sorting uses the pointers to these objects as arguments in the compare functions. The problem is that TFileItem is an internal class and cannot be accessed from outside the unit.

Therefore, it is not possible to extend TFileSortType by some fstCustom option and give GetfilesInDir an additional optional CompareFunc parameter... That was my first idea. I am afraid that all other solutions will require deeper changes in the ShellTreeView internals.

[d7_2_laz]

Yes, i understand these points (and feared this a bit).

So even no chance to open the access to  this function incl. TFileItem for a class helper? Tthat wouldn't change any existing behaviour, but could give an app a chance to modify it.
(I'd guess it's rather not possible and i'd need to patch the shellctrls.pas each time)

[wp]

Ignoring the compare function which you'd have to write anyway, here's a one-liner to sort the nodes of the shelltreeview in your preferred way:

Code: Pascal  [Select][+][-]

1. function TForm1.TreeViewCompare(Node1, Node2: TTreeNode): Integer;
2. var
3.   fn1, fn2: String;
4. begin
5.   fn1 := Node1.Text;
6.   fn2 := Node2.Text;
7.   if ((Pos('_', fn1) > 0) or (Pos('_', fn2) > 0)) then
8.      Result := AnsiCompareText(fn1, fn2)
9.   else
10.      Result := CompareText(fn1, fn2);
11. end;
12.  
13. procedure TForm1.ShellTreeView1Expanded(Sender: TObject; Node: TTreeNode);
14. begin
15.   Node.CustomSort(@TreeViewCompare);
16. end;

Keep ShellTreeView.FileSortType at fstNone to avoid duplicate sorting.

[d7_2_laz]

Sorry wp for my late response! (I'd been out yesterday)

Curios. I recently had noticed a forum article ("ttreeview and customsort") where the call to such function was triggered by a button click.
But i could not imagine why and how this should replace the builtin sort when binding the call to an event. Rather, that would add a second, "corrective" sort on top
of the builtin sort (time consuming ..).
So i didn'r pursue such approach. Seems i needed a final push (yours! Thanks!) to try out how that really behaves in practice.

Results:
- seen functionally it works fine
- for "normal" populated folders: no noticeable slowdown at all on top caused by the additional sorting. Absolutely very acceptable here!
- for "highly" populated folders (my standard test: Windows\WinSxS): a noticeable slowdown on top (approx 180 ms) disturbs
- Moreover: at the second expand (expand, collapse, expand again): the same delay happens again (although not necessary because the node is already populated and wll sorted)
So far: hmm. For file system oriented components i don't like unnecessary speed losses, so here i'd rather prefer to "continue patching". Sigh ...

I thought about to restrict the conditions for the call (= not at a subsequent expand; only if a need could be expected).
And ended up to try this "paranoia version" which does the job quite well at least in my specifc environment:

Code: Pascal  [Select][+][-]

1. procedure TfMain.ShDirTree1Expanded(Sender: TObject; Node: TTreeNode);
2. begin
3.   //Node.CustomSort(@TreeViewCompare);
4.   if Node.Count > 1 then   // else not possible or needed
5.      if (Pos('_', Node.Items[Node.Count -1].Text)) = 1 then  // Typically for highly populated folders this condition won't be met. Unless somebody invents windows system folders starting with "_" ......
6.         Node.CustomSort(@TreeViewCompare);
7. end;

What do you think? Is it reasonable to recommend such an approach for those who are accustomed to see sorting "sindows-like"?

[wp]

But i could not imagine why and how this should replace the builtin sort when binding the call to an event. Rather, that would add a second, "corrective" sort on top of the builtin sort (time consuming ..).

That's why I wrote to keep FileSortType at fstNone which avoids the primary sort during collecting the files.

I thought about to restrict the conditions for the call (= not at a subsequent expand; only if a need could be expected).
And ended up to try this "paranoia version" which does the job quite well at least in my specifc environment:

Code: Pascal  [Select][+][-]

1. procedure TfMain.ShDirTree1Expanded(Sender: TObject; Node: TTreeNode);
2. begin
3.   //Node.CustomSort(@TreeViewCompare);
4.   if Node.Count > 1 then   // else not possible or needed
5.      if (Pos('_', Node.Items[Node.Count -1].Text)) = 1 then  // Typically for highly populated folders this condition won't be met. Unless somebody invents windows system folders starting with "_" ......
6.         Node.CustomSort(@TreeViewCompare);
7. end;

But this works only when the name of the last file in the list starts with an underscore. This can't be true in general. '~', for example, is after the underscore in the ASCII character set, and often is used for temporary files...

What do you think? Is it reasonable to recommend such an approach for those who are accustomed to see sorting "sindows-like"?

Of course you can do what you want. But I would not like to have it in the official ShellTreeView because the windows-like sort order does not apply to all users.

I think the correct way would be to find a way to add the possibility of some custom sort to the file collection procedure (GetFilesInDir), i.e. provide a new TFileSortType fstCustom and a custom compare function.

[d7_2_laz]

to keep FileSortType at fstNone

Yes, right ... I'd lately removed the "FileSortType := fstAlphabet", but during the tests it had been still there. My fault. Changes a lot regarding the primary sort ..

this works only when the name of the last file in the list starts with an underscore

Yes, i'm aware. Therefore the somehow sceptical wording "my specifc environment". I'd seen here folders starting with "." or "$", but those were uncritical. - I'd thought about, for a short moment, for such cases to apply a backward lookup loop ... but, too much crude fuzzy logic.

a new TFileSortType fstCustom and a custom compare function

Yep. of course. Would be the best solution.

[BobDog]

Windows, console application.
Simple program.
Use the built in DOS sort.
(for fun)

Code: Pascal  [Select][+][-]

1.  
2. uses
3. sysutils,strutils,process;
4.  
5. type
6. aos=array of ansistring;
7.  
8.  type
9.  direction =(up,down);
10.  
11. function filelength(filename:ansistring):longword;
12. Var F : File Of byte;
13. var L:longword;
14. begin
15. Assign (F,filename);
16.   Reset (F);
17.   L:=FileSize(F);
18.   Close (F);
19.   exit(L);
20. end;
21.  
22. procedure savefile(s:ansistring ;filename:ansistring);
23.     var
24.     fout:file;
25.     begin
26.     Assign(fout,filename);
27.     Rewrite(fout,length(s));
28.     blockwrite(fout,s[1],1);
29.     close(fout);
30.   end;
31.  
32.  
33.   procedure loadfile(var content: ansistring;filename:ansistring);
34.    Var Fin : File;
35.    Var x:longint;
36.    begin
37.    x:=filelength(filename);
38.    setlength(content,x);
39.    Assign (Fin,filename);
40.    Reset (Fin,x);
41.    BlockRead (Fin,content[1],1);
42.    close(fin);
43. end;
44.  
45.  
46. function sort(s:array of ansistring;d:direction):aos;
47. var
48. cd,cmd,t:ansistring;
49. s2:ansistring='';
50. res:array of ansistring=nil;
51. j:int32;
52. tot:ansistring='';
53. delim:ansistring=chr(13)+chr(10);
54. begin
55.     t:='';
56.     cd:=getcurrentdir;
57.     for j:= low(s) to high(s) do tot:=tot+s[j]+delim;//chr(13)+chr(10);
58.    
59.     savefile(tot,cd+'\templist.txt');
60.     if (d=down) then
61.     cmd:= 'SORT.exe /r '+ cd + '\templist.txt /o ' +cd +'\result.txt'
62.     else
63.      cmd:= 'SORT.exe ' + cd + '\templist.txt /o ' +cd +'\result.txt' ;
64.      
65.     runcommand (cmd,t);
66.    loadfile(s2,cd+'\result.txt');
67.    res:=s2.split(delim);
68.     DeleteFile(cd+'\templist.txt');
69.     DeleteFile(cd+'\result.txt');
70.    exit(res);
71. end;
72.  
73.  
74. //------------------------//
75. function dir(path:ansistring;flag:ansistring):ansistring;
76.   var ans:ansistring=' ';
77.   begin
78.   RunCommand('c:\windows\system32\cmd.exe', ['/c', 'dir /'+flag+' '+path], ans);
79.   exit(ans);
80.   end;
81.  
82. procedure CreateAmixedString(var a:aos;maxlen:int32);
83.  function range(f:integer;l:integer):integer ;
84. begin
85.     range:=  random(1000000) mod (l-f+1) + f ;
86. end;
87.  
88. function mixcases:byte;
89. var i:integer;
90. begin
91.  i:=range(97,122);
92.  if random(10)<5 then i:=i-32;
93.  exit(i)
94. end;
95.  
96. var
97. i,l:int32;
98. begin
99. setlength(a,maxlen);
100.    for l:=0 to maxlen-1 do
101.    begin
102.    for i:=1 to 50 do a[l]:=a[l]+char(mixcases);
103.    begin
104.    a[l]:=midstr(a[l],1,range(10,49)); // make different lengths
105.    if random(10)<1 then a[l]:='_'+a[l];
106.    end;
107.    end;
108.      writeln('strings created, now sort ''em');
109. end;
110.  
111. var
112. a:aos=nil;
113. ans:aos=nil;
114. l:int32;
115. maxlen:int32=30;
116. s:ansistring='';
117. delim :ansistring=chr(13)+chr(10);
118.  
119. begin
120. randomize;
121. writeln('Creating a mixed case string array of ',maxlen,' elements');
122. CreateAmixedString(a,maxlen);
123.  
124. ans:=sort(a,up);
125. for l:=low(ans) to high(ans)-1 do writeln(l,'  ',ans[l]);
126. writeln('------------------');
127. s:=dir(GetCurrentDir ,'b');
128. ans:=s.split(delim);
129.  
130. ans:=sort(ans,down);
131. for l:=low(ans) to high(ans)-1 do writeln(l,'  ',ans[l]);
132. writeln('Press return to end');
133. readln;
134. end.
135.  

[d7_2_laz]

BobDog, thanks! I'll try it out asap!

Just as info, for the moment this (minimal modified) workaround does for me the job well for to reduce the overhead of calling an additional corrective node sort.  - A workaround, not more, but actually it does help me out.

Code: Pascal  [Select][+][-]

1. procedure TShDirtreeFilelist.ShDirTree_Expanded(Sender: TObject; Node: TTreeNode);
2. var p: Integer;
3. begin
4.   //Node.CustomSort(@TreeViewCompare);
5.   if Node.Count > 1 then begin
6.      //if (Pos('_', Node.Items[Node.Count -1].Text)) = 1 then
7.      p := Pos('_', Node.Items[Node.Count -1].Text);
8.      if p <> 1 then
9.         p := Pos('~', Node.Items[Node.Count -1].Text); // Other candidates may follow, But it's only a workaround ...
10.      if p = 1 then
11.         Node.CustomSort(@ShDirTree_NodeCompare);
12.   end;
13. end;
14.  
15. function TShDirtreeFilelist.ShDirTree_NodeCompare(Node1, Node2: TTreeNode): Integer;
16. var fn1, fn2: String;
17. begin
18.   fn1 := Node1.Text;
19.   fn2 := Node2.Text;
20.   if ((Pos('_', fn1) > 0) or (Pos('_', fn2) = 1)) then
21.      Result := AnsiCompareText(fn1, fn2)
22.   else
23.      Result := CompareText(fn1, fn2);
24. end;

[wp]

Just committed a new version of shellctrls which supports custom sorting in the tree (https://gitlab.com/freepascal.org/lazarus/lazarus/-/commit/cbf44a384b4788d6e87697db20b04fef80d979ba).

When ShellTreeView.FileSortType is fstCustom a user-defined compare function should be provided - it will be used for sorting while files and directories are collected (if it is not given no sorting is applied). This compare function is defined by the new property OnSortCompare which two TFileItem arguments and must return a negative value when the first fileitem is smaller, a positive value when the first item is larger, or zero when both fileitems are equal (as usual...).

TFileItem is an auxiliary class used during item collection and has been moved from the implementation part to the interface part of the unit.

Code: Pascal  [Select][+][-]

1. type
2.   TFileItem = class(TObject)
3.   private
4.     FFileInfo: TSearchRec;
5.     FBasePath: String;
6.   public
7.     isFolder: Boolean;
8.     constructor Create(const DirInfo: TSearchRec; ABasePath: String);
9.     property BasePath: String read FBasePath;
10.     property FileInfo: TSearchRec read FFileInfo write FFileInfo;
11.   end;

Here is a typical file item compare function, as preferred by d7_2_laz:

Code: Pascal  [Select][+][-]

1. function TForm1.SortCompareUnderscore(Item1, Item2: TFileItem): integer;
2. begin
3.   // Make sure that folders are moved to the top
4.   Result := ord(Item2.isFolder) - ord(Item1.isFolder);
5.   if Result = 0 then
6.     if (pos('_', Item1.FileInfo.Name) = 1) or (pos('_', Item2.FileInfo.Name) = 1) then
7.       Result := AnsiCompareText(Item1.FileInfo.Name, Item2.FileInfo.Name)
8.     else
9.       Result := CompareText(Item1.FileInfo.Name, Item2.FileInfo.Name);
10. end;

I am attaching a small test project containing the built-in sort methods (none, by name, folders first) as well as three custom sort methods (preferring underscore char, by size, by date). Note that this projects works only with the recent gitlab main branch!

Sorting by date reminded me that the ShellListView is lacking a date column...

[d7_2_laz]

It works. Fantastic! Wow! That does give enormous flexibility for all,who likes it each differeny!
From my side very huge thanks!

--
About the listview / additional date column: yes. i noted that too, but would not have opened a topic here (about add. column options) for not to bore.  As it's easily solvable with a helper class.
I had that already in my wrapper class, as well as access to the OnCustomDrawItem (as i don't like the darkblue backgrounded caption selection markers). I don't open a new topic here about (promised), but for info i add a small code excerpt snippet.
I mention that because i had read the belonging article in the german newsgroup and had been really surprised that i did _not_ encounter those resize recursive repaint issues that are mentioned there.
Attached a small text file with the stuff that i added resp was needed to be changedr (ie. within GetFiles). -  A column sort is not yet herein, i'm still starting.

[d2010]

Windows, console application.
Simple program.
Use the built in DOS sort.
(for fun)

Code: Pascal  [Select][+][-]

1. uses
2. sysutils,strutils,process;
3.  
4. type
5. aos=array of ansistring;
6.  
7.  type
8.  direction =(up,down);
9.  
10. function filelength(filename:ansistring):longword;
11. Var F : File Of byte;
12. var L:longword;
13. begin
14. Assign (F,filename);
15.   Reset (F);
16.   L:=FileSize(F);
17.   Close (F);
18.   exit(L);
19. end;
20.  
21. procedure savefile(s:ansistring ;filename:ansistring);
22.     var
23.     fout:file;
24.     begin
25.     Assign(fout,filename);
26.     Rewrite(fout,length(s));
27.     blockwrite(fout,s[1],1);
28.     close(fout);
29.   end;
30.  
31.  
32.   procedure loadfile(var content: ansistring;filename:ansistring);
33.    Var Fin : File;
34.    Var x:longint;
35.    begin
36.    x:=filelength(filename);
37.    setlength(content,x);
38.    Assign (Fin,filename);
39.    Reset (Fin,x);
40.    BlockRead (Fin,content[1],1);
41.    close(fin);
42. end;
43.  

You can check the file-operations with

Code: [Select]

    {$I-}
      blockread(Fin, inbuf, sizeof ( inbuf ), readpos );
    {$I+}
    IF ( ioresult <> 0 ) OR ( readpos = 0 ) THEN writeln('I Read Failed');


Code: [Select]

Var tranfile:system.file;
Function TranOpen(exew:word;Const FileName:string):integer;
Begin
  Assign (tranfile, FileName);
  filemode := 0;
 {$I-}
  reset (Tranfile, 1 );
  {$I+}
  Result:=IORESULT;
End; 

Begin
  if (TranOpen(1053,'E:\100\Ladrian2024\avicow\SMPlayer\docs\smtube\Copying.txt ')<>0) then
   Writeln('OpenFile error, user by other application exe');
End.