Author: Lou Adler
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:
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls;
7
8 type
9 TForm1 = class(TForm)
10 Button1: TButton;
11 ListBox1: TListBox;
12 Edit1: TEdit;
13 Label1: TLabel;
14 procedure Button1Click(Sender: TObject);
15 procedure FormCreate(Sender: TObject);
16 private
17 { Private declarations }
18 public
19 { Public declarations }
20 end;
21
22 type
23 TFolderContent = (
24 fcFiles, {Include all Files}
25 fcFolders, {Include all Folders}
26 fcHidden {Include all hidden objects}
27 );
28 TFolderContents = set of TFolderContent;
29 TFileResult = (
30 FileName, {Return a list of filenames}
31 Path {Return a list of complete file paths}
32 );
33
34 const
35 AllFolderContent = [fcFiles, fcFolders, fcHidden];
36
37 var
38 Form1: TForm1;
39
40 implementation
41
42 uses
43 ShellAPI, ShlObj, ActiveX;
44
45 {$R *.dfm}
46
47 var
48 SortFolder: IShellFolder;
49 SortColumn: Integer;
50
51 function ShellCompare(Item1, Item2: Pointer): Integer;
52 begin
53 Result := 0;
54 if Assigned(SortFolder) then
55 Result := ShortInt(SortFolder.CompareIDs(SortColumn, Item1, Item2));
56 end;
57
58 function PathToPIDL(APath: WideString): PItemIDList;
59 {Takes the passed Path and attempts to convert it to the equavalent PIDL}
60 var
61 Desktop: IShellFolder;
62 pchEaten, dwAttributes: ULONG;
63 begin
64 Result := nil;
65 SHGetDesktopFolder(Desktop);
66 dwAttributes := 0;
67 if Assigned(Desktop) then
68 Desktop.ParseDisplayName(0, nil, PWideChar(APath), pchEaten, Result,
69 dwAttributes);
70 end;
71
72 function StrRetToStr(StrRet: TStrRet; APIDL: PItemIDList; const Malloc: IMalloc):
73 WideString;
74 {Extracts the string from the StrRet structure}
75 var
76 P: PChar;
77 {S: string;}
78 begin
79 case StrRet.uType of
80 STRRET_CSTR:
81 begin
82 SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
83 {Result := S}
84 end;
85 STRRET_OFFSET:
86 begin
87 if Assigned(APIDL) then
88 begin
89 {$R-}
90 P := PChar(@(APIDL).mkid.abID[StrRet.uOffset - SizeOf(APIDL.mkid.cb)]);
91 {$R+}
92 SetString(Result, P, StrLen(P));
93 {Result := S;}
94 end
95 else
96 Result := '';
97 end;
98 STRRET_WSTR:
99 begin
100 Result := StrRet.pOleStr;
101 if Assigned(StrRet.pOleStr) then
102 Malloc.Free(StrRet.pOLEStr);
103 end;
104 end;
105 end;
106
107 function GetDirectoryFolder(Directory: WideString): IShellFolder;
108 var
109 Desktop: IShellFolder;
110 pchEaten, dwAttributes: ULONG;
111 PIDL: PItemIDList;
112 begin
113 SHGetDesktopFolder(Desktop);
114 if Assigned(Desktop) then
115 begin
116 PIDL := nil;
117 Desktop.ParseDisplayName(0, nil, PWideChar(Directory), pchEaten, PIDL,
118 dwAttributes);
119 if Assigned(PIDL) then
120 begin
121 Desktop.BindToObject(PIDL, nil, IShellFolder, Result);
122 CoTaskMemFree(PIDL);
123 end;
124 end;
125 end;
126
127 procedure EnumFolder(Folder: IShellFolder; Contents: TFolderContents; PIDLList:
128 TList);
129 var
130 Flags: Longword;
131 EnumList: IEnumIDList;
132 Fetched: ULONG;
133 PIDL: PItemIDList;
134 begin
135 Flags := 0;
136 if fcFiles in Contents then
137 Flags := Flags or SHCONTF_NONFOLDERS;
138 if fcFolders in Contents then
139 Flags := Flags or SHCONTF_FOLDERS;
140 if fcHidden in Contents then
141 Flags := Flags or SHCONTF_INCLUDEHIDDEN;
142 Folder.EnumObjects(0, Flags, EnumList);
143 if Assigned(EnumList) then
144 begin
145 while EnumList.Next(1, PIDL, Fetched) <> S_FALSE do
146 PIDLList.Add(PIDL);
147 end;
148 end;
149
150 procedure GetDirectoryContents(Directory: WideString; Contents: TFolderContents;
151 FileResult: TFileResult; SortOnColumn: Integer; FileList: TStringList);
152 {Parameters:
153 Directory: Path of the directory to get the contents of
154 Contents: What type of objects on the folder to include
155 FileResult: Return only the file names or the complete path for each file
156 SortOnColumn: What column (in Explorer report view) to sort the item on, 0 is the
157 name
158 FileList: The resulting file list user allocated}
159 var
160 Folder: IShellFolder;
161 PIDLList: TList;
162 i: Integer;
163 Malloc: IMalloc;
164 Flags: Longword;
165 StrRet: TStrRet;
166 begin
167 Assert(Assigned(FileList),
168 'User must allocate the FileString List in GetDirectoryContents');
169 Folder := GetDirectoryFolder(Directory);
170 if Assigned(Folder) then
171 begin
172 SHGetMalloc(Malloc);
173 PIDLList := TList.Create;
174 try
175 EnumFolder(Folder, Contents, PIDLList);
176 SortFolder := Folder;
177 SortColumn := SortOnColumn;
178 PIDLList.Sort(ShellCompare);
179 {Release the count on the interface}
180 SortFolder := nil;
181 FileList.Capacity := PIDLList.Count;
182 if FileResult = FileName then
183 Flags := SHGDN_NORMAL
184 else
185 Flags := SHGDN_FORPARSING;
186 for i := 0 to PIDLList.Count - 1 do
187 begin
188 FillChar(StrRet, SizeOf(StrRet), #0);
189 if Folder.GetDisplayNameOf(PIDLList[i], Flags, StrRet) = NOERROR then
190 FileList.Add(StrRetToStr(StrRet, PIDLList[i], Malloc));
191 end;
192 finally
193 for i := 0 to PIDLList.Count - 1 do
194 Malloc.Free(PIDLList[i]);
195 PIDLList.Free;
196 end;
197 end;
198 end;
199
200 procedure TForm1.Button1Click(Sender: TObject);
201 var
202 Files: TStringList;
203 begin
204 Files := TStringList.Create;
205 GetDirectoryContents(Edit1.Text, AllFolderContent, Path, 0, Files);
206 ListBox1.Items.Assign(Files);
207 Files.Free;
208 end;
209
210 procedure TForm1.FormCreate(Sender: TObject);
211 begin
212 Label1.Caption := 'Enter a Directory';
213 Edit1.Text := 'c:\';
214 end;
215
216 end.
|
