custom sort method in Delphi to sort list of strings

Question

I am trying to sort a list of files (they are stored as list of strings) in Delphi whose names look like below

a_1.xml
a_20.xml
a_10.xml
a_2.XML

when i use quick sort to sort the file names, it sorts the file names as below

a_1.xml
a_10.xml
a_2.xml
a_20.XML

But, I want the file names to be sorted in the below fashion

a_1.xml
a_2.xml
a_10.xml
a_20.XML

Any help will be greatly appreciated.

score 21 · Accepted Answer · answered Mar 06 '13 at 20:52

21

You can use the same compare function that Explorer uses, namely StrCmpLogicalW.

function StrCmpLogicalW(psz1, psz2: PWideChar): Integer; stdcall;
  external 'shlwapi.dll';

function StrCmpLogical(const s1, s2: string): Integer;
begin
  Result := StrCmpLogicalW(PChar(s1), PChar(s2));
end;

If you have your strings in a TStringList instance then you can use its CustomSort method. This expects a compare function of this form:

TStringListSortCompare = function(List: TStringList; 
  Index1, Index2: Integer): Integer;

So, feed CustomSort this function:

function StringListCompareLogical(List: TStringList; 
  Index1, Index2: Integer): Integer;
begin
  Result := StrCmpLogical(List[Index1], List[Index2]);
end;

answered Mar 06 '13 at 20:52

David Heffernan

601,492
42
1,072
1,490

there might be a rare case where the `'shlwapi.dll'` is tampered or missing. Then the application will not work. – rookie_developer Mar 07 '13 at 00:35
3

@rookie_developer: If shlwapi.dll is missing, the user probably couldn't launch your program anyway. It is a key part of the Windows shell, and StrCmpLogicalW was added with Windows XP. The main caution is that its behaviour MAY change (MSDN: Note Behavior of this function, and therefore the results it returns, can change from release to release. It should not be used for canonical sorting applications.) – Gerry Coll Mar 07 '13 at 00:51
@GerryColl: I understand that the `'shlwapi.dll'` DLL contains functions for UNC and URL paths, registry entries, and color settings .. why does tampering this file affect application launch ? – rookie_developer Mar 07 '13 at 04:10
I assume windows explorer would have trouble running without it, unless someone in MS thought there was a great need to run explorer without a file that was included in Win95 – Gerry Coll Mar 07 '13 at 06:11
Tampering's not an issue. All the programs that you write rely on system libraries. – David Heffernan Mar 07 '13 at 06:59
Damn! I am amazed of how many procedures and functions Delphi has one day!! – Bogdan Doicin Mar 07 '13 at 12:02
where can i get the exceptions that are raised by `StrCmpLogicalW()` function ?? – rookie_developer Mar 08 '13 at 20:59
It doesn't raise exceptions. It doesn't return errors. It won't fail if you follow the rules and feed it null terminated strings. – David Heffernan Mar 08 '13 at 21:51
@DavidHeffernan Hi. I couldnot make it work. It gives Incompatible types: 'Char' and 'WideChar' error. Also I didn't understand how to feed CustomSort. What should I type for index1 and index2. Can you please give an working example? BTW I'm using delphi7 and windows7 – Someone Jul 17 '13 at 20:17
3

@Leadri You are using a pre-Unicode Delphi, hence the type mismatch. Convert strings to WideString, and then cast to PWideChar. So, StrCmpLogicalW(PWideChar(WideString(s1)), PWideChar(WideString(s2)); then call it StringList.CustomSort(StringListCompareLogical) – David Heffernan Jul 17 '13 at 20:27

score 7 · Answer 2 · answered Mar 06 '13 at 20:58

7

A lightweight solution adjusted to your precise situation is as follows:

function compare(List: TStringList; Index1, Index2: Integer): Integer;
var
  n1, n2: integer;
begin
  n1 := StrToInt(Copy(List[Index1], 3, Length(List[Index1]) - 6));
  n2 := StrToInt(Copy(List[Index2], 3, Length(List[Index2]) - 6));
  result := n1 - n2;
end;

var
  sl: TStringList;

procedure AddAndSort;
begin
  sl := TStringList.Create;
  sl.Add('a_1.xml');
  sl.Add('a_20.xml');
  sl.Add('a_10.xml');
  sl.Add('a_2.XML');
  sl.CustomSort(compare);
end;

answered Mar 06 '13 at 20:58

Andreas Rejbrand

105,602
8
282
384

This works if I already know the file name and if the length of characters other than number are constant always. – rookie_developer Mar 07 '13 at 04:04
@rookie_developer: Of course. From your Q I got the impression that that was the case. – Andreas Rejbrand Mar 07 '13 at 09:23

Ingo · Answer 3 · 2021-08-22T15:05:47.453

The answer from Andreas Rejbrand was ok. But better you use this compare function for general use:

function compare(List: TStringList; Index1, Index2: Integer): Integer;
begin
  if Length(List[Index1]) = Length(List[Index2]) then
    begin
      if List[Index1] = List[Index2] then
        result := 0
      else
        if List[Index1] < List[Index2] then
          result := -1
        else
          result := 1;
    end
  else
    if Length(List[Index1]) < Length(List[Index2]) then
      result := -1
    else
      result := 1;
end;

//------------------------------------------------------------------

var sl: TStringList;

procedure AddAndSort;
begin
  sl := TStringList.Create;
  sl.Add('a_1.xml');
  sl.Add('a_20.xml');
  sl.Add('a_10.xml');
  sl.Add('a_2.XML');
  sl.CustomSort(compare);
end;

I think this will sort incorrectly - shorter strings will always precede longer ones. — dkellner, May 05 '18 at 00:45

score 1 · Answer 4 · answered Mar 06 '13 at 20:57

I wrote this one a couple of years ago as an answer here. It's a bit lengthy, but it does the trick.

function GTSmartCompare(List: TStringList; Index1, Index2: Integer): Integer;

  procedure ExtractPart(var s: string; out Result: string; out Numbers: Boolean);
  var
    n: integer;
  begin
    Numbers := False;
    n := 1;
    while (s[n] in ['0'..'9']) and (n <= Length(s)) do
      Inc(n);

    { n > 1 if there were digits at the start of the string}
    if n > 1 then
    begin
      Result := Copy(s, 1, n - 1);
      Delete(s, 1, n - 1);
      Numbers := True;
    end
    else
    begin
      { No digits }
      n := 1;
      while (not (s[n] in ['0'..'9']) ) and (n <= Length(s)) do
        Inc(n);

      if n > 1 then
      begin
        Result := Copy(s, 1, n - 1);
        Delete(s, 1, n - 1);
      end
    end;
  end; //ExtractPart()


  function CompareNextPart(var s1, s2: string): Integer;
  var
    n1, n2: Boolean;
    p1, p2: string;
  begin
    { Extract the next part for comparison }
    ExtractPart(s1, p1, n1);
    ExtractPart(s2, p2, n2);

    { Both numbers? The do a numerical comparison, otherwise alfabetical }
    if n1 and n2 then
      Result := StrToInt(p1) - StrToInt(p2)
    else
      Result := StrIComp(PChar(p1), PChar(p2));
  end; //CompareNextPart()

var
  str1, str2, ext1, ext2: string;

begin
  Result := 0;
  { For 'normal' comparison
    str2 := List[Index1];
    str2 := List[Index2];
    For comparing file names }

  ext1 := ExtractFileExt(List[Index1]);
  ext2 := ExtractFileExt(List[Index2]);
  str1 := ChangeFileExt(List[Index1], '');
  str2 := ChangeFileExt(List[Index2], '');

  while (str1 <> '') and (str2 <> '') and (Result = 0) do
    Result := CompareNextPart(str1, str2);

  { Comparing found no numerical differences, so repeat with a 'normal' compare. }

  if Result = 0 then
    Result := StrIComp(PChar(List[Index1]), PChar(List[Index2]));

  { Still no differences? Compare file extensions. }

  if Result = 0 then
    Result := StrIComp(PChar(ext1), PChar(ext2));

end;

[edit]

But why bother when David is awake. :p In my defence, back then many people didn't have Windows XP, which is the version in which StrCmpLogicalW was introduced.

This is fair enough if you don't have XP. But in that case I'd consider using the implementation of StrCmpLogicalW from Wine!! I expect that will implement all the nuances of the true Windows version. — David Heffernan, Mar 06 '13 at 21:03
Sure. This is actual old code. I wouldn't know why you would support pre-XP versions at all. Also, I'm not sure if this code is unicode safe. I just leave it here to gain some points -er- for educational purposes, but using StrCmpLogicalW makes more sense. — GolezTrol, Mar 06 '13 at 21:14

custom sort method in Delphi to sort list of strings

4 Answers4

Linked