ホーム >プログラム >Delphi 6 ローテクTips

ファイルのソート

ファイルとフォルダをTStringListに加えてソートさせると例えばファイルとサブフォルダが混在して並んでしまうことがあります。
それをファイルの後にサブフォルダがまとまって並ぶようにしたいと。

参考サイト

BlueLeaf1336-PROBLEMS-2003_0004 > Whose Window this is ?
http://www.geocities.jp/fjtkt/program/2004_0001.html

CustomSort

TStringListのCustomSortメソッドを使います。
CustomSortというのはつまるところ、

function FuncDescendingOrderSort(slList: TStringList; iIndex1, iIndex2: Integer): Integer;
begin
  //降順にソート
  Result := CompareText(slList[iIndex2], slList[iIndex1]);
end;

というように比較の結果を数字の大小で返す関数を作りなさいと。
そしてそれを

var
  lsl_List: TStrings;
begin
  lsl_List := TStringList.Create;
  try

    ...

    //lsl_Listは降順にソートされる
    lsl_List.CustomSort(FuncDescendingOrderSort);

    ...

  finally
    lsl_List.Free;
  end;
end;

のようにして使いなさいと。
そうすると FuncDescendingOrderSort の戻り値を使って並べ替えを行ってくれると。
リストの並び順の大小を返す関数を作りさえすればソートそのものはTStringListがやってくれると。
そういうことですね。

さてここからが本題です。
ファイルリストを取得してTStringListに保持してSortメソッドを呼びました。
ファイルとサブフォルダ中のファイルは分けてソートされるであろうと期待していました。
でも結果はファイルのリストの途中にサブフォルダ中のファイルが並んでソートされてしまうケースがありました。

上がFindFirstFileで取得したもの。
下がそれをSortしたもの。

例えば上の例のようにファイル名よりもサブフォルダのフォルダ名の方がASCII順で前の位置にある場合などです。
半角アルファベットのファイル名と日本語のファイル名があって半角アルファベットのサブフォルダがある場合なども日本語のファイル名の前に半角アルファベットのサブフォルダのファイルがきてしまいます。
まぁ考えてみれば当然なんですが。
StringListのソートはあくまでも文字列同士を比較して並べ替えているわけでファイルなのかフォルダなのかなんてことまではいちいち面倒見てくれません。
ならば自分で面倒みるしかないということでCustomSortの出番となります。

お手軽版

function FuncFileSort(List: TStringList; iIndex1, iIndex2: Integer): Integer;
begin
  //まずフォルダーだけで比較
  Result := CompareText(ExtractFilePath(List[iIndex1]), ExtractFilePath(slList[iIndex2]));
  if (Result = 0) then begin
    //フォルダーが同じならファイル名で比較
    Result := CompareText(ExtractFileName(List[iIndex1]), ExtractFileName(slList[iIndex2]));
  end;
  Application.ProcessMessages;
end;

ファイル名のソートなのでCaseSensitiveの値をみてCompareTextとCompareStrの使い分けをする必要はありません。
CompareTextだけでOKです。
この関数をCustomSortに与えてあげればフォルダとファイルとをきちんと分けてソートしてくれるようになります。

    //lsl_Listはファイルとフォルダを分けてソートされる
    lsl_List.CustomSort(FuncFileSort);

エクスプローラに似せる

たいていの場合は上記のやり方で充分だろうと思います。
ただしこの関数でソートされたリストの結果はエクスプローラの並びとは違っています。
エクスプローラでは数値文字列を数値として扱っています。

file_1.txt
file_2.txt
file_10.txt

という三つのファイルがあると、単純にソートした場合

file_1.txt
file_10.txt
file_2.txt

となります。単純にソートする場合、1や2や10は数値としての大小ではなくあくまで文字列として比較されるのでこうなります。
けれどもエクスプローラでは

file_1.txt
file_2.txt
file_10.txt

という並びになります。
これは1や2や10を文字列ではなく数値として扱いその大小で比較しているためと思われます。

ということでその動作を真似てみました。

procedure gpcFileDirNameDiv(sFile: WideString; out sPath, sName: WideString);
//sPathにパスをsNameにファイル名をセットする。
//パスの末尾の \ は返らない。
var
  i, li_Pos, li_Start: Integer;
begin
  li_Pos   := -1;
  li_Start :=  0;
  for i := Length(sFile) downto 1 do begin
    if (sFile[i] = '\') or (sFile[i] = '/') then begin
      li_Pos   := i - 1;
      li_Start := i + 1;
      Break;
    end else if (sFile[i] = ':') then begin
      li_Pos   := i;
      li_Start := i + 1;
      Break;
    end;
  end;
  sPath := Copy(sFile, 1, li_Pos);
  sName := Copy(sFile, li_Start, Length(sFile));
end;
function gfniCompareFileList(sStr1, sStr2: WideString): Integer;
  procedure lpc_StrNumDiv(sSrc: WideString; out sHeadStr, sNum, sEndStr: WideString);
  //sSrcを文字列と数値に分解する
  var
    i, k, li_Len: Integer;
    lb_Num: Boolean;
  begin
    sHeadStr := sSrc;
    sNum     := '';
    sEndStr  := '';
    lb_Num   := False;

    li_Len := Length(sSrc);
    for i := 1 to li_Len do begin
      if (sSrc[i] in [WideChar('0')..WideChar('9')]) then begin
        sHeadStr := Copy(sSrc, 1, i -1);
        for k := i+1 to li_Len do begin
          if not(sSrc[k] in [WideChar('0')..WideChar('9')]) then begin
            sNum    := Copy(sSrc, i, k - i);
            sEndStr := Copy(sSrc, k, MAXINT);
            lb_Num  := True;  //最後まで数値文字の場合この中に入ってこないことへの対策
            Break;
          end;
        end;
        if not(lb_Num) then begin
          sNum := Copy(sSrc, i, MAXINT);
        end;
        Break;
      end;
    end;
  end;

  function lfni_CompareFile(sStr1, sStr2: WideString): Integer;
  var
    ls_Head1, ls_Num1, ls_End1,
    ls_Head2, ls_Num2, ls_End2: WideString;
    li_Re: Integer;
    li_Num1, li_Num2: Int64;
  begin
    if (sStr1 = '') and (sStr2 = '') then begin
      Result := 0;
    end else if (sStr2 = '') then begin
      Result := 1;
    end else if (sStr1 = '') then begin
      Result := -1;
    end else begin
      Result := WideCompareText(sStr1, sStr2);
      if (Result = 0) then begin
        //sStr1とsStr2は同じ並び順
        if (WideUpperCase(sStr1) <> WideUpperCase(sStr2)) then begin
          //比較した場合は同じだが文字列としては同じではない場合への対処。
          //「が」とUnicodeの「か゛」の合成文字など。
          if (Length(sStr1) > Length(sStr2)) then begin
            //「が」より「か゛」の合成文字を前に持っていくため（簡単に済ませている）
            Result := -1;
          end else begin
            Result := 1;
          end;
        end;
      end else begin
        //sStr1とsStr2は違う並び順
        //数値の比較でエラーになった時ように退避しておく
        li_Re := Result;

        //文字列と数値文字列に分解'abc_12-A'->'abc_', '12', '-A'
        lpc_StrNumDiv(sStr1, ls_Head1, ls_Num1, ls_End1);
        lpc_StrNumDiv(sStr2, ls_Head2, ls_Num2, ls_End2);

        //数値文字列以前の文字列で比較
        if ((ls_Head1 = '') and (ls_Head2 <> ''))
        or ((ls_Head2 = '') and (ls_Head1 <> ''))
        then begin
          //どちらかが空文字だった。
          //'[.txt'と'1.txt'だと'[.txt'の方が先に並べられることへの対応。
        end else begin
          Result := gfniStringCompareText(ls_Head1, ls_Head2);
          if (Result = 0) then begin
            //数値文字列以前は同じだった。
            if (WideUpperCase(ls_Head1) <> (WideUpperCase(ls_Head2))) then begin
              //比較した場合は同じだが文字列としては同じではない場合への対処。
              //「が」とUnicodeの「か゛」の合成文字など。
              if (Length(ls_Head1) > Length(ls_Head2)) then begin
               //「が」より「か゛」の合成文字を前に持っていくため（簡単に済ませている）
                Result := 1;
              end else begin
                Result := -1;
              end;
            end else begin
              //数値以前の文字列が同じだったので数値文字列で比較
              if (ls_Num1 = '') and (ls_Num2 = '') then begin
                Result := 0;
              end else if (ls_Num2 = '') then begin
                Result := 1;
              end else if (ls_Num1 = '') then begin
                Result := -1;
              end else begin
                try
                  li_Num1 := StrToInt64(ls_Num1);
                  li_Num2 := StrToInt64(ls_Num2);
                  if (li_Num1 = li_Num2) then begin
                    Result := 0;
                  end else if (li_Num1 > li_Num2) then begin
                    Result := -1;
                  end else if (li_Num1 < li_Num2) then begin
                    Result := 1;
                  end;
                  if (Result = 0) then begin
                    Result := lfni_CompareFile(ls_End1, ls_End2);
                  end;
                except
                  //エラーが起きたら数値の比較は無効にしてしまう
                  Result := li_Re;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
var
  ls_Path1, ls_Name1,
  ls_Path2, ls_Name2: WideString;
begin
  if (sStr1 = sStr2) then begin
    Result := 0;
    Exit;
  end;

  gpcFileDirNameDiv(sStr1, ls_Path1, ls_Name1);
  gpcFileDirNameDiv(sStr2, ls_Path2, ls_Name2);
  //まずフォルダーだけで比較
  Result := lfni_CompareFile(ls_Path1, ls_Path2);
  if (Result = 0) then begin
    //フォルダーが同じならファイル名で比較
    Result := lfni_CompareFile(ls_Name1, ls_Name2);
  end;
end;
function FuncFileSortEx(List: TStringList; iIndex1, iIndex2: Integer): Integer;
//CustomSort用下請け関数
begin
  Result := gfniCompareFileList(List[iIndex1], List[iIndex2]);
end;
var
  lsl_List: TStrings;
begin
  lsl_List := TStringList.Create;
  try

    ...

    //lsl_Listはファイル名順にソートされる
    lsl_List.CustomSort(FuncFileSortEx);

    ...

  finally
    lsl_List.Free;
  end;
end;

これでファイル名に連番をつけている場合も期待した順番どおりソートされるようになります。

このほかにもエクスプローラの並びと合わせるためには全角の記号の扱いを調整する必要があるようです。
そこまでやろうとすると大変なのでパスということで。

2009-02-12:「が」より「か゛」の合成文字を前に持っていくように修正。
2009-01-21: