Duplicate the string sorting of the Windows XP Explorer (Views: 29)
Problem/Question/Abstract: I've noticed a change in Explorer's sorting algorithm. Under Windows 2000, one would see files sorted by name this way: A100, A20, A3, B100, B20, B3. Under Windows XP, one would see the same files sorted by name this way: A3, A20, A100, B3, B20, B100. Does anyone know of a string sort-compare function that uses this new sorting algorithm? I would prefer to not rely on an API call that doesn't exist in prior versions of Windows. Answer: unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls; type TForm1 = class(TForm) Button1: TButton; ListBox1: TListBox; Edit1: TEdit; Label1: TLabel; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; type TFolderContent = ( fcFiles, {Include all Files} fcFolders, {Include all Folders} fcHidden {Include all hidden objects} ); TFolderContents = set of TFolderContent; TFileResult = ( FileName, {Return a list of filenames} Path {Return a list of complete file paths} ); const AllFolderContent = [fcFiles, fcFolders, fcHidden]; var Form1: TForm1; implementation uses ShellAPI, ShlObj, ActiveX; {$R *.dfm} var SortFolder: IShellFolder; SortColumn: Integer; function ShellCompare(Item1, Item2: Pointer): Integer; begin Result := 0; if Assigned(SortFolder) then Result := ShortInt(SortFolder.CompareIDs(SortColumn, Item1, Item2)); end; function PathToPIDL(APath: WideString): PItemIDList; {Takes the passed Path and attempts to convert it to the equavalent PIDL} var Desktop: IShellFolder; pchEaten, dwAttributes: ULONG; begin Result := nil; SHGetDesktopFolder(Desktop); dwAttributes := 0; if Assigned(Desktop) then Desktop.ParseDisplayName(0, nil, PWideChar(APath), pchEaten, Result, dwAttributes); end; function StrRetToStr(StrRet: TStrRet; APIDL: PItemIDList; const Malloc: IMalloc): WideString; {Extracts the string from the StrRet structure} var P: PChar; {S: string;} begin case StrRet.uType of STRRET_CSTR: begin SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr)); {Result := S} end; STRRET_OFFSET: begin if Assigned(APIDL) then begin {$R-} P := PChar(@(APIDL).mkid.abID[StrRet.uOffset - SizeOf(APIDL.mkid.cb)]); {$R+} SetString(Result, P, StrLen(P)); {Result := S;} end else Result := ''; end; STRRET_WSTR: begin Result := StrRet.pOleStr; if Assigned(StrRet.pOleStr) then Malloc.Free(StrRet.pOLEStr); end; end; end; function GetDirectoryFolder(Directory: WideString): IShellFolder; var Desktop: IShellFolder; pchEaten, dwAttributes: ULONG; PIDL: PItemIDList; begin SHGetDesktopFolder(Desktop); if Assigned(Desktop) then begin PIDL := nil; Desktop.ParseDisplayName(0, nil, PWideChar(Directory), pchEaten, PIDL, dwAttributes); if Assigned(PIDL) then begin Desktop.BindToObject(PIDL, nil, IShellFolder, Result); CoTaskMemFree(PIDL); end; end; end; procedure EnumFolder(Folder: IShellFolder; Contents: TFolderContents; PIDLList: TList); var Flags: Longword; EnumList: IEnumIDList; Fetched: ULONG; PIDL: PItemIDList; begin Flags := 0; if fcFiles in Contents then Flags := Flags or SHCONTF_NONFOLDERS; if fcFolders in Contents then Flags := Flags or SHCONTF_FOLDERS; if fcHidden in Contents then Flags := Flags or SHCONTF_INCLUDEHIDDEN; Folder.EnumObjects(0, Flags, EnumList); if Assigned(EnumList) then begin while EnumList.Next(1, PIDL, Fetched) <> S_FALSE do PIDLList.Add(PIDL); end; end; procedure GetDirectoryContents(Directory: WideString; Contents: TFolderContents; FileResult: TFileResult; SortOnColumn: Integer; FileList: TStringList); {Parameters: Directory: Path of the directory to get the contents of Contents: What type of objects on the folder to include FileResult: Return only the file names or the complete path for each file SortOnColumn: What column (in Explorer report view) to sort the item on, 0 is the name FileList: The resulting file list user allocated} var Folder: IShellFolder; PIDLList: TList; i: Integer; Malloc: IMalloc; Flags: Longword; StrRet: TStrRet; begin Assert(Assigned(FileList), 'User must allocate the FileString List in GetDirectoryContents'); Folder := GetDirectoryFolder(Directory); if Assigned(Folder) then begin SHGetMalloc(Malloc); PIDLList := TList.Create; try EnumFolder(Folder, Contents, PIDLList); SortFolder := Folder; SortColumn := SortOnColumn; PIDLList.Sort(ShellCompare); {Release the count on the interface} SortFolder := nil; FileList.Capacity := PIDLList.Count; if FileResult = FileName then Flags := SHGDN_NORMAL else Flags := SHGDN_FORPARSING; for i := 0 to PIDLList.Count - 1 do begin FillChar(StrRet, SizeOf(StrRet), #0); if Folder.GetDisplayNameOf(PIDLList[i], Flags, StrRet) = NOERROR then FileList.Add(StrRetToStr(StrRet, PIDLList[i], Malloc)); end; finally for i := 0 to PIDLList.Count - 1 do Malloc.Free(PIDLList[i]); PIDLList.Free; end; end; end; procedure TForm1.Button1Click(Sender: TObject); var Files: TStringList; begin Files := TStringList.Create; GetDirectoryContents(Edit1.Text, AllFolderContent, Path, 0, Files); ListBox1.Items.Assign(Files); Files.Free; end; procedure TForm1.FormCreate(Sender: TObject); begin Label1.Caption := 'Enter a Directory'; Edit1.Text := 'c:\'; end; end. |