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.

Pickup

Answer 1

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;

Lope

there might be a rare case where the 'shlwapi.dll' is tampered or missing. Then the application will not work. – Pickup

@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.) – Lubbock

@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 ? – Pickup

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 – Lubbock

Tampering's not an issue. All the programs that you write rely on system libraries. – Lope

Damn! I am amazed of how many procedures and functions Delphi has one day!! – Brisk

where can i get the exceptions that are raised by StrCmpLogicalW() function ?? – Pickup

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. – Lope

@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 – Fiume

@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) – Lope

Answer 2

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;

Veinlet

This works if I already know the file name and if the length of characters other than number are constant always. – Pickup

@rookie_developer: Of course. From your Q I got the impression that that was the case. – Veinlet

Answer 3

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;

Lyns

I think this will sort incorrectly - shorter strings will always precede longer ones. – Ingrate

Answer 4

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.

Sterner

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. – Lope

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. – Sterner