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.

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;

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;

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;

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.