Both the source and exe are included.
It takes a few mins to scan your drive,
but file searching is blazing.
It uses a few linked lists to store the
index, but the footprint is still pretty
small.
It only holds the index in memory, however,
so you have to wait for the re-scan if you
close it by accident.
Disclaimer: This program is sub-standard,
and due to quality/security/usability
issues, should not be used by anyone.
Avert your eyes, children. It may assume
another form.
1
2 {
3 Issues:
4 --------
5 - Sorting starts to get kind of slow with > 3000 items
6 - Consider implementing the max/min bubble-sort enhancement
7 - More internal docs needed
8
9 Wish-List:
10 ----------
11 - A good book, a glass of scotch and a warm breeze to fill my sails
12
13
14 History:
15 ------------
16 Oct 29/04
17 - Began development
18
19 Nov 05/04
20 - Changed the Matches list box to a grid for ease of reading
21 - Added the Size and Last Modified columns to the Matches grid
22 - Added the asterisk wildcard to the search box
23 - Consolidated the folder list to reduce the memory footprint
24
25 Nov 09/04
26 - Implemented the Statistics page
27 - Implemented the File Sizes statistics page
28
29 Nov 10/04
30 - Implemented the Folders statistics page
31 - Implemented the Modifications statistics page
32 - Enhanced the CompareToSearchPhrase function so it handles >1 wildcard
33
34 Nov 11/04
35 - Fixed a bug in the CompareToSearchPhrase function
36 - Fixed several bugs relating to statistical graphing
37 - Added a check to keep folders from being added if their parent already
38 includes them
39
40 Nov 12/04
41 - Added the "By Size" and "By Modified Time" search range options
42 - Removed the "Last Modified File" display from the Modifications statistics
43 page
44
45 Nov 17/04
46 - Implemented a prototype of a TreeView-based directory selection page
47 - Implemented auto-drive discovery for the TreeView
48 - Implemented structure discovery for the selected drives of the TreeView
49
50 Nov 19/04
51 - Implemented file discovery for the tree view
52 - Remove all the list-based learning controls & methods
53 - Implemented the Match/Doesn't Match checkbox for search by filename
54
55 Nov 22/04
56 - Fixed a bug that kept files from being learned if the the folders weren't
57 discovered first
58 - Moved the scales to the left side of graphs, keeping the values on the right
59 side
60
61 Nov 24/04
62 - Added single-char wildcard searches (and made searching much cleaner) with
63 donated code
64 from Ritchie Annand.
65
66 Nov 26/04
67 - Minor esthetic adjustment to labels on the Statistics pages.
68 - Move the amounts to the left side of the Folder Statistics lists.
69 - Began working on the click-results-column-to-sort functionality
70
71 Nov 29/04
72 - Got bubble sort working (Ascending only) for the results grid.
73
74 Nov 30/04
75 - Got the Ascending/Descending toggle to work on the search result sort
76 - Allowed the selected item to be maintained during sorting
77
78
79
80 }
81
82 unit Unit1;
83
84 interface
85
86 uses
87 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
88 Dialogs, StdCtrls, FileCtrl, Grids, ExtCtrls, ComCtrls;
89
90 {Information on each folder is stored in one of these records.}
91 {There are stored in a separate linked-list and pointed to by the Folder attrib
92 of TFilePtr. This saves the space used by storing the folder info which each
93 file.}
94 type
95 TFolderPtr = ^TFolderElem;
96 TFolderElem = record
97 Folder: string;
98 UCFolder: string; {Upper-case folder name. Increases sorting efficiency.}
99 FileCount: Integer; {used on the Statistics pages.}
100 TotalFileSize: Int64; {used on the Statistics pages.}
101 Next: TFolderPtr;
102 end;
103
104 {Information on each file is stored in one of these records.}
105 type
106 TFilePtr = ^TFileElem;
107 TFileElem = record
108 FileName: string;
109 UCFileName: string; {Upper-case file name. Increases sorting efficiency.}
110 Folder: TFolderPtr;
111 Size: Integer;
112 LastModified: TDateTime;
113 SearchMatch: Boolean; {...True, if this item matches the search criteria.}
114 Next: TFilePtr; {...points to the next item, in natural order.}
115 NextMatch: TFilePtr; {...points to the next item matching the search criteria.
116 These links are used in the sorting routines.}
117 end;
118
119 type
120 TfrmHereMain = class(TForm)
121 pgcMain: TPageControl;
122 tsLocate: TTabSheet;
123 pnlLocateControls: TPanel;
124 Label1: TLabel;
125 edtFileName: TEdit;
126 btnCopyFullPath: TButton;
127 edtSelectedMatch: TEdit;
128 lblMatchCount: TLabel;
129 sgMatches: TStringGrid;
130 tsStatistics: TTabSheet;
131 pgcStatistics: TPageControl;
132 tsFileSizes: TTabSheet;
133 tsFolders: TTabSheet;
134 tsModifications: TTabSheet;
135 Panel2: TPanel;
136 Label4: TLabel;
137 lblLargestFileName: TLabel;
138 Label6: TLabel;
139 lblLargestFileSize: TLabel;
140 Label8: TLabel;
141 Label5: TLabel;
142 lblLargestFileFolder: TLabel;
143 lblAverageFileSize: TLabel;
144 Label7: TLabel;
145 lblTotalFiles: TLabel;
146 pbxFileSizes: TPaintBox;
147 Panel4: TPanel;
148 Label9: TLabel;
149 lblFoldersByFileCount: TLabel;
150 Panel5: TPanel;
151 lblFoldersByFileSize: TLabel;
152 lbxFoldersByFileCount: TListBox;
153 lbxFoldersByFileSize: TListBox;
154 lblFolderCount: TLabel;
155 Splitter1: TSplitter;
156 pbxFileMods: TPaintBox;
157 ckbSearchByFileName: TCheckBox;
158 ckbSearchBySize: TCheckBox;
159 ckbSearchByModTime: TCheckBox;
160 edtSizeAmount: TEdit;
161 edtModAmount: TEdit;
162 cbxModUnits: TComboBox;
163 btnSearch: TButton;
164 cbxSizeUnits: TComboBox;
165 edtModAmount2: TEdit;
166 cbxModUnits2: TComboBox;
167 ckbSearchByModTimeTo: TCheckBox;
168 edtSizeAmount2: TEdit;
169 cbxSizeUnits2: TComboBox;
170 Label3: TLabel;
171 tsLearn: TTabSheet;
172 Panel1: TPanel;
173 TreeView1: TTreeView;
174 btnDiscoverFolders: TButton;
175 btnLearnFilesNow: TButton;
176 btnWhyDiscoverFolders: TButton;
177 cbxIncludeParent: TCheckBox;
178 pnlDiscovering: TPanel;
179 Panel3: TPanel;
180 Label2: TLabel;
181 cbxFileNameMatchType: TComboBox;
182 procedure btnCopyFullPathClick(Sender: TObject);
183 procedure FormCreate(Sender: TObject);
184 procedure FormDestroy(Sender: TObject);
185 procedure FormResize(Sender: TObject);
186 procedure FormShow(Sender: TObject);
187 procedure sgMatchesSelectCell(Sender: TObject; ACol, ARow: Integer;
188 var CanSelect: Boolean);
189 procedure sgMatchesDrawCell(Sender: TObject; ACol, ARow: Integer;
190 Rect: TRect; State: TGridDrawState);
191 procedure tsFileSizesShow(Sender: TObject);
192 procedure pbxFileSizesPaint(Sender: TObject);
193 procedure tsFoldersShow(Sender: TObject);
194 procedure tsModificationsShow(Sender: TObject);
195 procedure pbxFileModsPaint(Sender: TObject);
196 procedure edtSizeAmountKeyPress(Sender: TObject; var Key: Char);
197 procedure btnSearchClick(Sender: TObject);
198 procedure edtSizeAmountExit(Sender: TObject);
199 procedure ckbSearchByModTimeClick(Sender: TObject);
200 procedure edtSizeAmount2Exit(Sender: TObject);
201 procedure TreeView1CustomDrawItem(Sender: TCustomTreeView;
202 Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
203 procedure TreeView1Addition(Sender: TObject; Node: TTreeNode);
204 procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
205 Shift: TShiftState; X, Y: Integer);
206 procedure TreeView1KeyPress(Sender: TObject; var Key: Char);
207 procedure TreeView1Collapsing(Sender: TObject; Node: TTreeNode;
208 var AllowCollapse: Boolean);
209 procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
210 var AllowExpansion: Boolean);
211 procedure btnDiscoverFoldersClick(Sender: TObject);
212 procedure btnWhyDiscoverFoldersClick(Sender: TObject);
213 procedure btnLearnFilesNowClick(Sender: TObject);
214 procedure sgMatchesMouseUp(Sender: TObject; Button: TMouseButton;
215 Shift: TShiftState; X, Y: Integer);
216 private
217 bResultSortAscending, bExpanding, bCollapsing, bFilesHaveBeenLearned,
218 bCustomDraw: Boolean;
219 sLargestFileName: string;
220 iKnownFolderCount, iKnownFileCount, iResultsSortByCol, iAverageFileSizeCount,
221 iLargestFileSize, iFolderCount: Integer;
222 iMatchCount, iAverageFileSizeTotal, iSizeFloor, iSizeCeiling: Int64;
223 dModTimeFloor, dModTimeCeiling: Double;
224 pKnownFiles, pMatches: TFilePtr;
225 pKnownFolders: TFolderPtr;
226 aryFileSizes, aryModDaysAgo: array[0..12] of Integer;
227 aryFoldersByFileCount, aryFoldersByFileSize: array[0..99] of TFolderPtr;
228 oChecked, oPartiallyChecked: TObject;
229 function AllDescendantsAreChecked(aParent: TTreeNode): Boolean;
230 procedure BuildDriveList(var aList: TStringList);
231 procedure BuildRecursiveFileList(aFolder: string; aSearchSubFolders: Boolean);
232 procedure CheckTopFoldersByFileCount(var aFolder: TFolderPtr);
233 procedure CheckTopFoldersByFileSize(var aFolder: TFolderPtr);
234 procedure ClearAllListsAndCounts;
235 procedure ClearFileList(var aList: TFilePtr);
236 procedure ClearFolderList(var aList: TFolderPtr);
237 procedure ClearResultsGrid;
238 procedure ClearSearchMatches(var aList: TFilePtr);
239 procedure DiscoverRootNodeFolders;
240 procedure DisplaySearchResults;
241 procedure DrawFileModChart;
242 procedure DrawFileSizeChart;
243 procedure FolderToTreeNodes(aFolder: string; aParentNode: TTreeNode);
244 procedure GatherStatistics;
245 function GetNodePath(var aNode: TTreeNode): string;
246 procedure HandleNodeClick(aNode: TTreeNode);
247 procedure InformChildNodes(aNode: TTreeNode);
248 procedure InformParentNode(aParent: TTreeNode; aChecked: Boolean);
249 procedure LearnFilesInFolder(aFolder: string);
250 procedure LearnFilesInNode(var aNode: TTreeNode);
251 procedure LinkMatches;
252 procedure LoadDriveNodes;
253 procedure PerformLocate;
254 procedure PerformSort(aColumn: Integer; aAscending: Boolean);
255 procedure SelectRowByObject(var aSelected: TFilePtr);
256 procedure SetGridColWidths;
257 procedure SetLearnButtonAccessability;
258 procedure SortResults(aColumn: Integer);
259 public
260 end;
261
262 var
263 frmHereMain: TfrmHereMain;
264
265 function Matches(const ASource, APattern: string; ACaseSensitive: Boolean=False):
266 Boolean;
267 function _StrComp(var aStr1, aStr2: string): Integer;
268
269 implementation
270
271 {$R *.dfm}
272
273 procedure TfrmHereMain.PerformLocate;
274 var
275 pElem: TFilePtr;
276 sSearchPhrase: string;
277 bMeetsCriteria: Boolean;
278 dtNow: TDateTime;
279 begin
280 sgMatches.Visible := False;
281 ClearResultsGrid;
282
283 dtNow := Now;
284 sSearchPhrase := UpperCase(Trim(edtFileName.Text));
285
286 btnSearch.Enabled := False;
287 btnCopyFullPath.Enabled := False;
288 lblMatchCount.Caption := 'searching...';
289 lblMatchCount.Refresh;
290
291 ClearSearchMatches(pKnownFiles);
292 pElem := pKnownFiles;
293 iMatchCount := 0;
294 while pElem <> nil do begin
295 bMeetsCriteria := True;
296
297 if ckbSearchBySize.Checked then
298 bMeetsCriteria := (pElem^.Size >= iSizeFloor) and (pElem^.Size <=
299 iSizeCeiling);
300
301 if bMeetsCriteria and ckbSearchByModTime.Checked then begin
302 bMeetsCriteria := ((dtNow - dModTimeCeiling) <= pElem^.LastModified);
303 if bMeetsCriteria and ckbSearchByModTimeTo.Checked then
304 bMeetsCriteria := ((dtNow - dModTimeFloor) >= pElem^.LastModified);
305 end;
306
307 if bMeetsCriteria and ckbSearchByFileName.Checked then
308 bMeetsCriteria := Matches(pElem^.UCFileName, sSearchPhrase, false) xor
309 (cbxFileNameMatchType.ItemIndex = 1);
310
311 if bMeetsCriteria then begin
312 pElem^.SearchMatch := True;
313 inc(iMatchCount);
314 end;
315
316 pElem := pElem^.Next;
317 end;
318
319 LinkMatches;
320 DisplaySearchResults;
321 sgMatches.Row := 1;
322 edtSelectedMatch.Text := sgMatches.Cells[1, sgMatches.Row]+sgMatches.Cells[0,
323 sgMatches.Row];
324 btnCopyFullPath.Enabled := (iMatchCount > 0);
325 btnSearch.Enabled := True;
326 sgMatches.Visible := True;
327 end;
328
329 procedure TfrmHereMain.LinkMatches;
330 var
331 pLastMatch, pSearcher: TFilePtr;
332 bFirstMatch: Boolean;
333 begin
334 {This proc connects the search results via their NextMatch attrib.}
335 bFirstMatch := True;
336 pSearcher := pKnownFiles;
337 while pSearcher <> nil do begin
338 if pSearcher^.SearchMatch then begin
339 if bFirstMatch then begin
340 pMatches := pSearcher;
341 bFirstMatch := False;
342 end;
343 if pLastMatch <> nil then
344 pLastMatch^.NextMatch := pSearcher;
345 pLastMatch := pSearcher;
346 end;
347 pSearcher := pSearcher^.Next;
348 end;
349 end;
350
351 procedure TfrmHereMain.ClearSearchMatches(var aList: TFilePtr);
352 var
353 pElem: TFilePtr;
354 begin
355 {This proc undoes any evidence that any items ever matched the search criteria.}
356 pElem := aList;
357 while pElem <> nil do begin
358 pElem^.SearchMatch := False;
359 pElem^.NextMatch := nil;
360 pElem := pElem^.Next;
361 end;
362 end;
363
364 procedure TfrmHereMain.ClearResultsGrid;
365 begin
366 lblMatchCount.Caption := '';
367 with sgMatches do begin
368 while RowCount > 2 do begin
369 Objects[0, RowCount-1] := nil;
370 Rows[RowCount-1].Clear;
371 RowCount := RowCount - 1;
372 end;
373 Rows[1].Clear;
374 end;
375 end;
376
377 procedure TfrmHereMain.DisplaySearchResults;
378 var
379 iRow: Integer;
380 pElem: TFilePtr;
381 sFileSize: string;
382 begin
383 ClearResultsGrid;
384 pElem := pMatches;
385 while pElem <> nil do
386 with sgMatches do begin
387 if pElem^.SearchMatch then begin
388 if Cells[0,1] <> '' then RowCount := RowCount + 1;
389 iRow := RowCount - 1;
390 Cells[0, iRow] := pElem^.FileName;
391 Cells[1, iRow] := pElem^.Folder^.Folder;
392 sFileSize := FormatFloat('###,###,###,##0', Round(pElem^.Size/1024))+' KB';
393 Cells[2, iRow] := sFileSize;
394 Cells[3, iRow] := FormatDateTime('MM/DD/YYYY HH:NN', pElem^.LastModified);
395 Objects[0, iRow] := TObject(pElem);
396 end;
397 pElem := pElem^.NextMatch;
398 end;
399
400 lblMatchCount.Caption := FormatFloat('###,###,##0', iMatchCount) + ' matches';
401 end;
402
403 function Matches(const ASource, APattern: string;
404 ACaseSensitive: Boolean=False): Boolean;
405 {This function was donated by Ritchie Annand.}
406 function MatchPattern(ASourcePart, APatternPart: PChar): Boolean;
407 begin
408 if StrComp(APatternPart,'*')=0 then
409 Result := True // * matches everything
410 else if ASourcePart^=#0 then // end of the string
411 Result := APatternPart^=#0 // is there still pattern remaining?
412 else
413 case APatternPart^ of
414 '*' :
415 if MatchPattern(ASourcePart,APatternPart+1) then
416 Result := True
417 else
418 Result := MatchPattern(ASourcePart+1,APatternPart);
419 '?' :
420 Result := MatchPattern(ASourcePart+1,APatternPart+1);
421 else
422 if ACaseSensitive then
423 if ASourcePart^=APatternPart^ then
424 Result := MatchPattern(ASourcePart+1,APatternPart+1)
425 else
426 Result := False
427 else
428 if Upcase(ASourcePart^)=Upcase(APatternPart^) then
429 Result := MatchPattern(ASourcePart+1,APatternPart+1)
430 else
431 Result := False;
432 end;
433 end;
434 begin
435 Result := MatchPattern(PChar(ASource),PChar(APattern));
436 end;
437
438
439 procedure TfrmHereMain.btnCopyFullPathClick(Sender: TObject);
440 begin
441 edtSelectedMatch.SelectAll;
442 edtSelectedMatch.CopyToClipboard;
443 end;
444
445 procedure TfrmHereMain.FormCreate(Sender: TObject);
446 begin
447 bFilesHaveBeenLearned := False;
448 pKnownFiles := nil;
449 pKnownFolders := nil;
450 pKnownFolders := nil;
451 bCustomDraw := True;
452 oChecked := TObject.Create;
453 oPartiallyChecked := TObject.Create;
454 bExpanding := False;
455 bCollapsing := False;
456 iKnownFolderCount := 0;
457 end;
458
459 procedure TfrmHereMain.FormDestroy(Sender: TObject);
460 begin
461 ClearFileList(pKnownFiles);
462 ClearFolderList(pKnownFolders);
463 pKnownFiles := nil;
464 pKnownFolders := nil;
465 oChecked.Free;
466 oPartiallyChecked.Free;
467 end;
468
469 procedure TfrmHereMain.ClearFileList(var aList: TFilePtr);
470 var
471 pKiller: TFilePtr;
472 begin
473 pKiller := aList;
474 while pKiller <> nil do begin
475 aList := aList^.Next;
476 Dispose(pKiller);
477 pKiller := aList;
478 end;
479 end;
480
481 procedure TfrmHereMain.ClearFolderList(var aList: TFolderPtr);
482 var
483 pKiller: TFolderPtr;
484 begin
485 pKiller := aList;
486 while pKiller <> nil do begin
487 aList := aList^.Next;
488 Dispose(pKiller);
489 pKiller := aList;
490 end;
491 end;
492
493 procedure TfrmHereMain.FormResize(Sender: TObject);
494 begin
495 pnlDiscovering.Left := Trunc((Width/2)-(pnlDiscovering.Width/2));
496 pnlDiscovering.Top := Trunc((Height/2)-(pnlDiscovering.Height/2));
497 SetGridColWidths;
498 edtFileName.Width := (pnlLocateControls.Width - 30) - edtFileName.Left;
499 btnSearch.Left := Round((pnlLocateControls.Width/2) - Round(btnSearch.Width/2));
500 lblMatchCount.Left := (pnlLocateControls.Width - lblMatchCount.Width) - 3;
501 end;
502
503 procedure TfrmHereMain.SetGridColWidths;
504 begin
505 with sgMatches do begin
506 ColWidths[0] := Trunc(sgMatches.Width * 0.27);
507 ColWidths[1] := Trunc(sgMatches.Width * 0.37);
508 ColWidths[2] := Trunc(sgMatches.Width * 0.10);
509 ColWidths[3] := Trunc(sgMatches.Width * 0.22);
510 end;
511 end;
512
513 procedure TfrmHereMain.FormShow(Sender: TObject);
514 begin
515 pgcMain.ActivePageIndex := 0;
516 pgcStatistics.ActivePageIndex := 0;
517 tsLocate.TabVisible := False;
518 tsStatistics.TabVisible := False;
519 sgMatches.Cells[0,0] := 'File';
520 sgMatches.Cells[1,0] := 'Folder';
521 sgMatches.Cells[2,0] := 'Size';
522 sgMatches.Cells[3,0] := 'Last Modified';
523 SetGridColWidths;
524 TreeView1.Items.Clear;
525 LoadDriveNodes;
526 end;
527
528 procedure TfrmHereMain.sgMatchesSelectCell(Sender: TObject; ACol, ARow: Integer;
529 var CanSelect: Boolean);
530 begin
531 edtSelectedMatch.Text := sgMatches.Cells[1, ARow]+sgMatches.Cells[0, ARow];
532 end;
533
534 procedure TfrmHereMain.sgMatchesDrawCell(Sender: TObject; ACol,
535 ARow: Integer; Rect: TRect; State: TGridDrawState);
536 var
537 iTextWidth: Integer;
538 begin
539 if (aCol = 2) {Size} then begin
540 { determine the width the text will be, when displayed }
541 iTextWidth := sgMatches.Canvas.TextExtent(sgMatches.Cells[ACol, ARow]).cx;
542 { right justify the column text by re-drawing it manually }
543 sgMatches.Canvas.TextRect(Rect, Rect.right - iTextWidth - 3,Rect.Top+2,
544 sgMatches.Cells[ACol, ARow]);
545 end;
546 end;
547
548 procedure TfrmHereMain.GatherStatistics;
549 var
550 pEye: TFilePtr;
551 pFolder: TFolderPtr;
552 i: Integer;
553 begin
554 iLargestFileSize := 0;
555 sLargestFileName := '';
556 for i := 0 to 12 do aryFileSizes[i] := 0;
557 for i := 0 to 12 do aryModDaysAgo[i] := 0;
558 pEye := pKnownFiles;
559 while pEye <> nil do begin
560 {Largest File Size}
561 if pEye^.Size > iLargestFileSize then begin
562 iLargestFileSize := pEye^.Size;
563 sLargestFileName := pEye^.Folder^.Folder+pEye^.FileName;
564 end;
565 {File Size graph}
566 case pEye^.Size of
567 0..512: inc(aryFileSizes[0]);
568 513..1024: inc(aryFileSizes[1]);
569 1025..2048: inc(aryFileSizes[2]);
570 2049..4096: inc(aryFileSizes[3]);
571 4099..8192: inc(aryFileSizes[4]);
572 8193..16384: inc(aryFileSizes[5]);
573 16385..32768: inc(aryFileSizes[6]);
574 32769..65536: inc(aryFileSizes[7]);
575 65537..131072: inc(aryFileSizes[8]);
576 131073..262144: inc(aryFileSizes[9]);
577 262145..524288: inc(aryFileSizes[10]);
578 524289..1048576: inc(aryFileSizes[11]);
579 else
580 inc(aryFileSizes[12]);
581 end;
582 {File Modifications graph}
583 case Round((Now-pEye^.LastModified)+1) of
584 0..1: inc(aryModDaysAgo[0]);
585 2: inc(aryModDaysAgo[1]);
586 3: inc(aryModDaysAgo[2]);
587 4: inc(aryModDaysAgo[3]);
588 5: inc(aryModDaysAgo[4]);
589 6: inc(aryModDaysAgo[5]);
590 7: inc(aryModDaysAgo[6]);
591 8..30: inc(aryModDaysAgo[7]); {1 week - 1 mo}
592 31..183: inc(aryModDaysAgo[8]); {1 mo - 6 mo}
593 184..365: inc(aryModDaysAgo[9]); {6 mo - 1 yr}
594 366..730: inc(aryModDaysAgo[10]); {1 yr - 2 yrs}
595 731..1096: inc(aryModDaysAgo[11]); {2 yrs - 3 yrs}
596 else
597 inc(aryModDaysAgo[12]); {3+ yrs}
598 end;
599 {Average File Size}
600 iAverageFileSizeTotal := iAverageFileSizeTotal + pEye^.Size;
601 inc(iAverageFileSizeCount);
602 {Folder File Count}
603 inc(pEye^.Folder^.FileCount);
604 {Folder File Size Total}
605 pEye^.Folder^.TotalFileSize := pEye^.Folder^.TotalFileSize + pEye^.Size;
606
607 pEye := pEye^.Next;
608 end;
609
610 {# of Folders}
611 iFolderCount := 0;
612 pFolder := pKnownFolders;
613 while pFolder <> nil do begin
614 inc(iFolderCount);
615 CheckTopFoldersByFileCount(pFolder);
616 CheckTopFoldersByFileSize(pFolder);
617 pFolder := pFolder^.Next;
618 end;
619
620 tsFileSizesShow(self);
621 tsFoldersShow(self);
622 tsModificationsShow(self);
623 end;
624
625 procedure TfrmHereMain.tsFileSizesShow(Sender: TObject);
626 begin
627 if not bFilesHaveBeenLearned then Exit;
628
629 lblTotalFiles.Caption := FormatFloat('###,###,###,###,##0', iKnownFileCount);
630 lblAverageFileSize.Caption := FormatFloat('###, ###, ###, ##0 KB',
631 Round((iAverageFileSizeTotal/iAverageFileSizeCount)/1024));
632 lblLargestFileName.Caption := ExtractFileName(sLargestFileName);
633 lblLargestFileFolder.Caption := ExtractFilePath(sLargestFileName);
634 lblLargestFileSize.Caption := FormatFloat('###, ###, ###, ##0 KB',
635 iLargestFileSize);
636 DrawFileSizeChart;
637 end;
638
639 procedure TfrmHereMain.DrawFileSizeChart;
640 const
641 aryBars: array[0..12] of PChar = ('0-0.5KB', '0.5-1KB', '1-2KB', '2-4KB',
642 '4-8KB', '8-16KB', '16-32KB', '32-64KB', '64-128KB', '128-256KB',
643 '256-512KB','512-1MB','1MB+');
644 var
645 iHighestCount, i, iX, iBarBottom, iBar, iBarThickness: Integer;
646 iScaleFactor: Double;
647 begin
648 iBarBottom := pbxFileSizes.Left + 60;
649 with pbxFileSizes.Canvas do begin
650 Pen.Style := psSolid;
651 Font.Size := 8;
652 iBarThickness := 13;
653 iHighestCount := 0;
654 for i := 0 to 12 do
655 if aryFileSizes[i] > iHighestCount then
656 iHighestCount := aryFileSizes[i];
657 iScaleFactor := iHighestCount/(pbxFileSizes.Width-125);
658
659 Pen.Color := clGray;
660 iX := 0;
661 for iBar := 0 to High(aryFileSizes) do begin
662 if Pen.Color = clNavy then
663 Pen.Color := clGray
664 else
665 Pen.Color := clNavy;
666 for i := (iBar*iBarThickness) to ((iBar*iBarThickness)+12) do begin
667 MoveTo(iBarBottom, i);
668 iX := iBarBottom + Round(aryFileSizes[iBar]/iScaleFactor);
669 LineTo(iX, i);
670 end;
671 {Legend}
672 Brush.Color := clBtnFace;
673 TextOut(2, (iBar*iBarThickness), aryBars[iBar]);
674 TextOut(iX+2, (iBar*iBarThickness), FormatFloat('###,###,##0',
675 aryFileSizes[iBar]));
676 end;
677 end;
678 end;
679
680 procedure TfrmHereMain.pbxFileSizesPaint(Sender: TObject);
681 begin
682 tsFileSizesShow(Sender);
683 end;
684
685 procedure TfrmHereMain.tsFoldersShow(Sender: TObject);
686 var
687 i: Integer;
688 begin
689 if not bFilesHaveBeenLearned then Exit;
690
691 lblFolderCount.Caption := FormatFloat('###,###,##0', iFolderCount);
692 lbxFoldersByFileCount.Items.Clear;
693 lbxFoldersByFileSize.Items.Clear;
694
695 for i := 0 to 99 do
696 if aryFoldersByFileCount[i] <> nil then
697 lbxFoldersByFileCount.Items.Add(FormatFloat('###,###,##0',
698 aryFoldersByFileCount[i]^.FileCount) + ' - ' + aryFoldersByFileCount[i]^.Folder);
699 lblFoldersByFileCount.Caption := 'Top ' +
700 IntToStr(lbxFoldersByFileCount.Items.Count) + ' Folders (by File Count):';
701
702 for i := 0 to 99 do
703 if aryFoldersByFileSize[i] <> nil then
704 lbxFoldersByFileSize.Items.Add(FormatFloat('###,###,##0MB',
705 aryFoldersByFileSize[i]^.TotalFileSize/1048576) + ' - ' +
706 aryFoldersByFileSize[i]^.Folder);
707 lblFoldersByFileSize.Caption := 'Top ' +
708 IntToStr(lbxFoldersByFileSize.Items.Count) + ' Folders (by File Size):';
709 end;
710
711 procedure TfrmHereMain.CheckTopFoldersByFileCount(var aFolder: TFolderPtr);
712 var
713 i, iFBFCIndex: Integer;
714 pHold: TFolderPtr;
715 aryTemp: array[0..99] of TFolderPtr;
716 begin
717 { Clear the temp array }
718 for i := 0 to 99 do aryTemp[i] := nil;
719 pHold := aFolder;
720 iFBFCIndex := 0;
721 { Insert pHold (aka aFolder) in the correct position, front & back-filled by the
722 main array (aryFoldersByFileCount) }
723 for i := 0 to 99 do
724 if pHold = nil then begin
725 aryTemp[i] := aryFoldersByFileCount[iFBFCIndex];
726 inc(iFBFCIndex);
727 end else
728 if aryFoldersByFileCount[i]=nil then begin
729 aryTemp[i] := pHold;
730 pHold := nil;
731 end else
732 if pHold^.FileCount > aryFoldersByFileCount[i]^.FileCount then begin
733 aryTemp[i] := pHold;
734 pHold := nil;
735 end else begin
736 aryTemp[i] := aryFoldersByFileCount[iFBFCIndex];
737 inc(iFBFCIndex);
738 end;
739 { Use the values from the temp array as the new main array }
740 for i := 0 to 99 do
741 aryFoldersByFileCount[i] := aryTemp[i];
742 end;
743
744 procedure TfrmHereMain.CheckTopFoldersByFileSize(var aFolder: TFolderPtr);
745 var
746 i, iFBFSIndex: Integer;
747 pHold: TFolderPtr;
748 aryTemp: array[0..99] of TFolderPtr;
749 begin
750 { Clear the temp array }
751 for i := 0 to 99 do aryTemp[i] := nil;
752 pHold := aFolder;
753 iFBFSIndex := 0;
754 { Insert pHold (aka aFolder) in the correct position, front & back-filled by the
755 main array (aryFoldersByFileSize) }
756 for i := 0 to 99 do
757 if pHold = nil then begin
758 aryTemp[i] := aryFoldersByFileSize[iFBFSIndex];
759 inc(iFBFSIndex);
760 end else
761 if aryFoldersByFileSize[i]=nil then begin
762 aryTemp[i] := pHold;
763 pHold := nil;
764 end else
765 if pHold^.TotalFileSize > aryFoldersByFileSize[i]^.TotalFileSize then begin
766 aryTemp[i] := pHold;
767 pHold := nil;
768 end else begin
769 aryTemp[i] := aryFoldersByFileSize[iFBFSIndex];
770 inc(iFBFSIndex);
771 end;
772 { Use the values from the temp array as the new main array }
773 for i := 0 to 99 do
774 aryFoldersByFileSize[i] := aryTemp[i];
775 end;
776
777 procedure TfrmHereMain.tsModificationsShow(Sender: TObject);
778 begin
779 if not bFilesHaveBeenLearned then Exit;
780
781 DrawFileModChart;
782 end;
783
784 procedure TfrmHereMain.DrawFileModChart;
785 const
786 aryBars: array[0..12] of PChar = ('0-1 days', '2 days', '3 days', '4 days',
787 '5 days', '6 days', '7 days', '8-30 days', '1-6 mo', '6 mo - 1 yr',
788 '1 - 2 yrs','2 - 3 yrs','3+ yrs');
789 var
790 iHighestCount, i, iX, iBarBottom, iBar, iBarThickness: Integer;
791 iScaleFactor: Double;
792 begin
793 iBarBottom := pbxFileMods.Left + 60;
794 with pbxFileMods.Canvas do begin
795 Pen.Style := psSolid;
796 Font.Size := 8;
797 iBarThickness := 13;
798 iHighestCount := 0;
799 for i := 0 to 12 do
800 if aryModDaysAgo[i] > iHighestCount then
801 iHighestCount := aryModDaysAgo[i];
802 iScaleFactor := iHighestCount/(pbxFileMods.Width-125);
803
804 Pen.Color := clGray;
805 iX := 0;
806 for iBar := 0 to High(aryModDaysAgo) do begin
807 if Pen.Color = clNavy then
808 Pen.Color := clGray
809 else
810 Pen.Color := clNavy;
811 for i := (iBar*iBarThickness) to ((iBar*iBarThickness)+12) do begin
812 MoveTo(iBarBottom, i);
813 iX := iBarBottom + Round(aryModDaysAgo[iBar]/iScaleFactor);
814 LineTo(iX, i);
815 end;
816 {Legend}
817 Brush.Color := clBtnFace;
818 TextOut(2, (iBar*iBarThickness), aryBars[iBar]);
819 TextOut(iX+2, (iBar*iBarThickness), FormatFloat('###,###,##0',
820 aryModDaysAgo[iBar]));
821 end;
822 end;
823 end;
824
825 procedure TfrmHereMain.pbxFileModsPaint(Sender: TObject);
826 begin
827 tsModificationsShow(sender);
828 end;
829
830 procedure TfrmHereMain.edtSizeAmountKeyPress(Sender: TObject; var Key: Char);
831 begin
832 { Only digits are allowed. #8 is back-space. }
833 if Pos(Key, '1234567890'+#8) = 0 then
834 Key := #0;
835 end;
836
837 procedure TfrmHereMain.btnSearchClick(Sender: TObject);
838 var
839 sTemp: string;
840 iTemp: Int64;
841 dTemp: Double;
842 begin
843 if ((not ckbSearchByFileName.Checked) and (not ckbSearchBySize.Checked) and (not
844 ckbSearchByModTime.Checked)) then begin
845 MessageDlg('Please include at least one of the search methods using the
846 check-boxes on the left.'0);
847 Exit;
848 end;
849
850 if ckbSearchByFileName.Checked then begin
851 if Length(Trim(edtFileName.Text)) < 3 then begin
852 MessageDlg('Please enter at least 3 characters for the file name pattern.',
853 mtInformation, [mbok], 0);
854 edtFileName.SetFocus;
855 Exit;
856 end;
857 if Pos('**', Trim(edtFileName.Text)) > 0 then begin
858 MessageDlg('Wildcards(*) may not be adjacent to each other.'+#13#13+'eg. **A,
859 A**, ***'mation, [mbok], 0);
860 edtFileName.SetFocus;
861 Exit;
862 end;
863 end;
864
865 iSizeFloor := StrToInt(Trim(edtSizeAmount.Text));
866 case cbxSizeUnits.ItemIndex of
867 0: iSizeFloor := iSizeFloor*1024; {KBs}
868 1: iSizeFloor := iSizeFloor*1024*1024; {MBs}
869 2: iSizeFloor := iSizeFloor*1024*1024*1024; {GBs}
870 end;
871 iSizeCeiling := StrToInt(Trim(edtSizeAmount2.Text));
872 case cbxSizeUnits2.ItemIndex of
873 0: iSizeCeiling := iSizeCeiling*1024; {KBs}
874 1: iSizeCeiling := iSizeCeiling*1024*1024; {MBs}
875 2: iSizeCeiling := iSizeCeiling*1024*1024*1024; {GBs}
876 end;
877
878 if iSizeFloor > iSizeCeiling then begin
879 iTemp := iSizeFloor;
880 iSizeFloor := iSizeCeiling;
881 iSizeCeiling := iTemp;
882 end;
883
884 dModTimeCeiling := StrToInt(Trim(edtModAmount2.Text));
885 case cbxModUnits2.ItemIndex of
886 0: dModTimeCeiling := (dModTimeCeiling/24)/60; {Minutes}
887 1: dModTimeCeiling := dModTimeCeiling/24; {Hours}
888 2: dModTimeCeiling := dModTimeCeiling; {Days}
889 3: dModTimeCeiling := dModTimeCeiling*7; {Weeks}
890 4: dModTimeCeiling := dModTimeCeiling*365; {Years}
891 end;
892
893 dModTimeFloor := StrToInt(Trim(edtModAmount.Text));
894 case cbxModUnits.ItemIndex of
895 0: dModTimeFloor := (dModTimeFloor/24)/60; {Minutes}
896 1: dModTimeFloor := dModTimeFloor/24; {Hours}
897 2: dModTimeFloor := dModTimeFloor; {Days}
898 3: dModTimeFloor := dModTimeFloor*7; {Weeks}
899 4: dModTimeFloor := dModTimeFloor*365; {Years}
900 end;
901
902 if (ckbSearchByModTime.Checked and ckbSearchByModTimeTo.Checked) then
903 if dModTimeFloor > dModTimeCeiling then
904 if MessageDlg('Your modification time range values are inverted. Would you
905 like to fix this and continue searching?'
906 then begin
907 sTemp := Trim(edtModAmount.Text);
908 edtModAmount.Text := Trim(edtModAmount2.Text);
909 edtModAmount2.Text := sTemp;
910 iTemp := cbxModUnits.ItemIndex;
911 cbxModUnits.ItemIndex := cbxModUnits2.ItemIndex;
912 cbxModUnits2.ItemIndex := iTemp;
913 dTemp := dModTimeFloor;
914 dModTimeFloor := dModTimeCeiling;
915 dModTimeCeiling := dTemp;
916 end else
917 Exit;
918
919 PerformLocate;
920 end;
921
922 procedure TfrmHereMain.ckbSearchByModTimeClick(Sender: TObject);
923 begin
924 ckbSearchByModTimeTo.Enabled := ckbSearchByModTime.Checked;
925 edtModAmount2.Enabled := ckbSearchByModTime.Checked;
926 cbxModUnits2.Enabled := ckbSearchByModTime.Checked;
927 end;
928
929 procedure TfrmHereMain.edtSizeAmountExit(Sender: TObject);
930 begin
931 { Trim spaces }
932 TEdit(Sender).Text := Trim(TEdit(Sender).Text);
933 { Don't allow blank }
934 if TEdit(Sender).Text = '' then TEdit(Sender).Text := '0'; {Zero is allowed}
935 { Trim leading zeros }
936 while (TEdit(Sender).Text[1] = '0') and (Length(TEdit(Sender).Text) > 1) do
937 TEdit(Sender).Text := Copy(TEdit(Sender).Text, 2, Length(TEdit(Sender).Text));
938 { Don't allow blank }
939 if TEdit(Sender).Text = '' then TEdit(Sender).Text := '0'; {Zero is allowed}
940 end;
941
942 procedure TfrmHereMain.edtSizeAmount2Exit(Sender: TObject);
943 begin
944 { Trim spaces }
945 TEdit(Sender).Text := Trim(TEdit(Sender).Text);
946 { Don't allow blank }
947 if TEdit(Sender).Text = '' then TEdit(Sender).Text := '1'; {Zero is not allowed}
948 { Trim leading zeros }
949 while (TEdit(Sender).Text[1] = '0') and (Length(TEdit(Sender).Text) > 1) do
950 TEdit(Sender).Text := Copy(TEdit(Sender).Text, 2, Length(TEdit(Sender).Text));
951 { Don't allow blank }
952 if TEdit(Sender).Text = '' then TEdit(Sender).Text := '1'; {Zero is not allowed}
953 end;
954
955 procedure TfrmHereMain.TreeView1CustomDrawItem(Sender: TCustomTreeView;
956 Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
957 var
958 rRect, rBtnRect, rCheckBox: TRect;
959 nParent: TTreeNode;
960
961 procedure AdjustRectSize(var aRect: TRect; aAdjust: Integer);
962 begin
963 Dec(aRect.Left, aAdjust);
964 Dec(aRect.Top, aAdjust);
965 Inc(aRect.Right, aAdjust);
966 Inc(aRect.Bottom, aAdjust);
967 end;
968
969 procedure DrawExpansionButton(aRect: TRect);
970 begin
971 with TCustomTreeView(Sender).Canvas do begin
972 {Draw box}
973 Pen.Style := psSolid;
974 Pen.Color := clSilver;
975 Rectangle(aRect);
976 {Clear inner edge of box}
977 Pen.Color := clWhite;
978 AdjustRectSize(aRect, -1);
979 Rectangle(aRect);
980 {Draw plus/minus signs}
981 Pen.Color := clBlack;
982 AdjustRectSize(aRect, 1);
983 if Node.Expanded then begin
984 {Draw minus sign}
985 MoveTo(aRect.Left + 2, aRect.Top+4);
986 LineTo(aRect.Left + 7, aRect.Top+4);
987 end else begin
988 {Draw plus sign}
989 MoveTo(aRect.Left + 4, aRect.Top+2);
990 LineTo(aRect.Left + 4, aRect.Top+7);
991 MoveTo(aRect.Left + 2, aRect.Top+4);
992 LineTo(aRect.Left + 7, aRect.Top+4);
993 end;
994 end; {with}
995 end;
996
997 procedure DrawCheckBox(aRect: TRect);
998 var
999 iLine: Integer;
1000 begin
1001 with TCustomTreeView(Sender).Canvas do begin
1002 Pen.Color := clSilver;
1003 Rectangle(aRect);
1004 if Node.Data <> nil then begin
1005 {Draw checkmark}
1006 if Node.Data = oChecked then
1007 Pen.Color := clBlack {fully checked}
1008 else
1009 Pen.Color := clSilver; {partially checked & Partially checked include}
1010 for iLine := 0 to 2 do begin
1011 MoveTo(aRect.Left+2, aRect.Top+4+iLine);
1012 LineTo(aRect.Left+4, aRect.Top+6+iLine);
1013 LineTo(aRect.Left+9, aRect.Top+1+iLine);
1014 end;
1015 end;
1016 end; {with}
1017 end;
1018begin
1019 DefaultDraw := not bCustomDraw;
1020 if not bCustomDraw then Exit;
1021 rRect := Node.DisplayRect(false);
1022 rBtnRect := Rect(rRect.Left+5+(Node.Level*19), rRect.Top+4,
1023rRect.Left+14+(Node.Level*19), rRect.Top+13);
1024 with TCustomTreeView(Sender).Canvas do begin
1025 Pen.Color := clSilver;
1026 Pen.Style := psSolid;
1027
1028 {Line from button to text}
1029 Pen.Color := clSilver;
1030 MoveTo(rRect.Left+9+(Node.Level*19), rRect.Top+8);
1031 LineTo(rRect.Left+18+(Node.Level*19), rRect.Top+8);
1032
1033 if not Node.IsFirstNode then begin
1034 {All nodes, except the first, have a line from their center to the
1035 one above, be it parent or sibling}
1036 {Draw line from top of rect to middle}
1037 MoveTo(rBtnRect.Left+4, rRect.Top);
1038 LineTo(rBtnRect.Left+4, rRect.Top+Round((rRect.Bottom-rRect.Top)/2));
1039 end;
1040
1041 if (Node.getNextSibling <> nil) then begin
1042 {Node has a lower sibling}
1043 {Draw line from middle this node to bottom of Rect}
1044 MoveTo(rBtnRect.Left+4, rRect.Top+Round((rRect.Bottom-rRect.Top)/2));
1045 LineTo(rBtnRect.Left+4, rRect.Bottom);
1046 end;
1047
1048 nParent := Node.Parent;
1049 while nParent <> nil do begin
1050 if (nParent.getNextSibling <> nil) then begin
1051 {Draw Ancestor Line Segments}
1052 MoveTo(rRect.Left+9+(nParent.Level*TTreeView(Sender).Indent), rRect.Top);
1053 LineTo(rRect.Left+9+(nParent.Level*TTreeView(Sender).Indent), rRect.Bottom);
1054 end;
1055 nParent := nParent.Parent;
1056 end;
1057
1058 if Node.HasChildren then
1059 DrawExpansionButton(rBtnRect);
1060
1061 rCheckBox := Rect(rBtnRect.Right+6, rRect.Top+3, rBtnRect.Right+17,
1062rRect.Bottom-2);
1063 DrawCheckBox(rCheckBox);
1064 TextOut(rCheckBox.Right+2, rRect.Top+1, Node.Text);
1065 end; {with}
1066end;
1067
1068procedure TfrmHereMain.TreeView1Addition(Sender: TObject; Node: TTreeNode);
1069begin
1070 {The portion of the node that captures click events starts with the check box,
1071 but only extends as far as the length of the text. Since the text is shifted
1072 to the right, spaces must be added to the end to ensure the the last few
1073 characters are clickable.}
1074 //tw - a more elegant fix is needed
1075 Node.Text := Node.Text+' ';
1076 Node.Data := nil;
1077end;
1078
1079procedure TfrmHereMain.TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
1080Shift: TShiftState; X, Y: Integer);
1081begin
1082 if bCollapsing then begin
1083 bCollapsing := False;
1084 Exit;
1085 end;
1086 if bExpanding then begin
1087 bExpanding := False;
1088 Exit;
1089 end;
1090 HandleNodeClick(TTreeView(Sender).Selected);
1091end;
1092
1093procedure TfrmHereMain.TreeView1KeyPress(Sender: TObject; var Key: Char);
1094begin
1095 if Key = ' ' then
1096 HandleNodeClick(TTreeView(Sender).Selected);
1097end;
1098
1099procedure TfrmHereMain.HandleNodeClick(aNode: TTreeNode);
1100begin
1101 if aNode = nil then Exit;
1102 if aNode.Data <> oChecked then
1103 aNode.Data := oChecked
1104 else
1105 aNode.Data := nil;
1106
1107 if aNode.HasChildren then
1108 InformChildNodes(aNode);
1109
1110 if aNode.Parent <> nil then
1111 InformParentNode(aNode.Parent, (aNode.Data <> nil));
1112
1113 aNode.TreeView.Refresh;
1114 SetLearnButtonAccessability;
1115end;
1116
1117procedure TfrmHereMain.InformParentNode(aParent: TTreeNode; aChecked: Boolean);
1118begin
1119 if aChecked then
1120 if AllDescendantsAreChecked(aParent) then
1121 aParent.Data := oChecked
1122 else
1123 aParent.Data := oPartiallyChecked
1124 else
1125 aParent.Data := oPartiallyChecked;
1126 if aParent.Parent <> nil then
1127 InformParentNode(aParent.Parent, (aParent.Data <> nil));
1128end;
1129
1130function TfrmHereMain.AllDescendantsAreChecked(aParent: TTreeNode): Boolean;
1131var
1132 nDescendant: TTreeNode;
1133begin
1134 result := True;
1135 nDescendant := aParent.getFirstChild;
1136 while (nDescendant <> nil) and result do begin
1137 if nDescendant.Data = nil then begin
1138 result := False;
1139 Break;
1140 end;
1141 if nDescendant.HasChildren then
1142 result := AllDescendantsAreChecked(nDescendant);
1143 nDescendant := aParent.GetNextChild(nDescendant);
1144 end;
1145end;
1146
1147procedure TfrmHereMain.InformChildNodes(aNode: TTreeNode);
1148var
1149 nChild: TTreeNode;
1150begin
1151 nChild := aNode.getFirstChild;
1152 while nChild <> nil do begin
1153 nChild.Data := aNode.Data;
1154 if nChild.HasChildren then
1155 InformChildNodes(nChild);
1156 nChild := aNode.GetNextChild(nChild);
1157 end;
1158end;
1159
1160procedure TfrmHereMain.TreeView1Collapsing(Sender: TObject;
1161 Node: TTreeNode; var AllowCollapse: Boolean);
1162begin
1163 bCollapsing := True;
1164end;
1165
1166procedure TfrmHereMain.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
1167 var AllowExpansion: Boolean);
1168begin
1169 bExpanding := True;
1170end;
1171
1172procedure TfrmHereMain.LoadDriveNodes;
1173var
1174 slDrives: TStringList;
1175 iFolder: Integer;
1176begin
1177 slDrives := TStringList.Create;
1178 BuildDriveList(slDrives);
1179 for iFolder := 0 to (slDrives.Count - 1) do
1180 TreeView1.Items.AddChild(nil, slDrives[iFolder]);
1181 slDrives.Free;
1182end;
1183
1184procedure TfrmHereMain.DiscoverRootNodeFolders;
1185var
1186 nRootNode: TTreeNode;
1187begin
1188 bFilesHaveBeenLearned := False;
1189 pnlDiscovering.Caption := 'Discovering Folders...';
1190 pnlDiscovering.visible := True;
1191 pnlDiscovering.Refresh;
1192 ClearAllListsAndCounts;
1193 nRootNode := TreeView1.Items.GetFirstNode;
1194 while nRootNode <> nil do begin
1195 inc(iKnownFolderCount);
1196 if nRootNode.Data = oChecked then begin
1197 nRootNode.DeleteChildren;
1198 FolderToTreeNodes(Trim(nRootNode.Text), nRootNode);
1199 end;
1200 nRootNode := nRootNode.getNextSibling;
1201 end;
1202 pnlDiscovering.visible := False;
1203end;
1204
1205procedure TfrmHereMain.BuildDriveList(var aList: TStringList);
1206var
1207 DriveNum: Integer;
1208 DriveChar: Char;
1209 DriveBits: set of 0..25;
1210begin
1211 aList.Clear;
1212 Integer(DriveBits) := GetLogicalDrives;
1213 for DriveNum := 0 to 25 do
1214 begin
1215 if not (DriveNum in DriveBits) then Continue;
1216 DriveChar := UpCase(Char(DriveNum + Ord('a')));
1217 aList.Add(DriveChar+':');
1218 end; {for}
1219end;
1220
1221procedure TfrmHereMain.FolderToTreeNodes(aFolder: string; aParentNode: TTreeNode);
1222var
1223 srSearcher: TSearchRec;
1224 sFolder: string;
1225 aNewNode: TTreeNode;
1226begin
1227 sFolder := aFolder + '\*.*';
1228 if FindFirst(sFolder, faDirectory, srSearcher) = 0 then begin
1229 repeat
1230 if (srSearcher.Attr and faDirectory) <> 0 then
1231 if (srSearcher.Name <> '.') and (srSearcher.Name <> '..') then begin
1232 aNewNode := TreeView1.Items.AddChild(aParentNode, srSearcher.Name);
1233 aNewNode.Data := oChecked;
1234 inc(iKnownFolderCount);
1235 if (iKnownFolderCount mod 100) = 0 then begin
1236 pnlDiscovering.Caption := 'Discovered ' +
1237FormatFloat('###,###,###,##0',iKnownFolderCount) + ' Folders';
1238 pnlDiscovering.Refresh;
1239 end;
1240 FolderToTreeNodes(aFolder + '\' + srSearcher.Name, aNewNode);
1241 end;
1242 until FindNext(srSearcher) <> 0;
1243 FindClose(srSearcher);
1244 end;
1245end;
1246
1247
1248procedure TfrmHereMain.btnDiscoverFoldersClick(Sender: TObject);
1249begin
1250 if MessageDlg('This process may take a few minutes, especially if you''ve ' +
1251 'selected any network drives.'+#13#13+'Would you like to proceed?',
1252 mtConfirmation, [mbyes, mbno], 0) = mrYes then begin
1253 iKnownFolderCount := 0;
1254 DiscoverRootNodeFolders;
1255 end;
1256end;
1257
1258
1259procedure TfrmHereMain.btnWhyDiscoverFoldersClick(Sender: TObject);
1260begin
1261 MessageDlg('Why would I want to Discover Folders?' + #13#13 +
1262 'Discovering the folders of the selected drives allows you to include/exclude '
1263+
1264 'specific folders of these drives, rather than learning all the files on the ' +
1265 'drive. However, the discovery process may take a few minutes. This process '
1266+
1267 'may be considerably longer if you''ve selected any mapped network drives.',
1268 mtInformation, [mbok], 0);
1269end;
1270
1271procedure TfrmHereMain.btnLearnFilesNowClick(Sender: TObject);
1272var
1273 nRootNode: TTreeNode;
1274begin
1275 bFilesHaveBeenLearned := False;
1276 pnlDiscovering.Caption := 'Discovering Files...';
1277 pnlDiscovering.visible := True;
1278 pnlDiscovering.Refresh;
1279 frmHereMain.Enabled := False;
1280 ClearAllListsAndCounts;
1281 nRootNode := TreeView1.Items.GetFirstNode;
1282 while nRootNode <> nil do begin
1283 if nRootNode.Data <> nil then
1284 if nRootNode.HasChildren then
1285 LearnFilesInNode(nRootNode)
1286 else
1287 BuildRecursiveFileList(Trim(nRootNode.Text), True);
1288 nRootNode := nRootNode.getNextSibling;
1289 end;
1290 GatherStatistics;
1291 pnlDiscovering.visible := False;
1292 frmHereMain.Enabled := True;
1293 bFilesHaveBeenLearned := True;
1294 tsLocate.TabVisible := True;
1295 tsStatistics.TabVisible := True;
1296end;
1297
1298procedure TfrmHereMain.BuildRecursiveFileList(aFolder: string; aSearchSubFolders:
1299Boolean);
1300var
1301 srSearcher: TSearchRec;
1302 sFolder: string;
1303 pNew: TFilePtr;
1304 pNewFolder: TFolderPtr;
1305begin
1306 if aFolder[Length(aFolder)] <> '\' then aFolder := aFolder + '\';
1307
1308 New(pNewFolder);
1309 pNewFolder^.Folder := aFolder;
1310 pNewFolder^.UCFolder := UpperCase(aFolder);
1311 pNewFolder^.FileCount := 0;
1312 pNewFolder^.TotalFileSize := 0;
1313 pNewFolder^.Next := pKnownFolders;
1314 pKnownFolders := pNewFolder;
1315
1316 sFolder := aFolder + '*.*';
1317 if FindFirst(sFolder, faAnyFile, srSearcher) = 0 then begin
1318 repeat
1319
1320 if (srSearcher.Attr and faDirectory) <> 0 then begin
1321 if (srSearcher.Name <> '.') and (srSearcher.Name <> '..') and
1322aSearchSubFolders then
1323 BuildRecursiveFileList(aFolder + srSearcher.Name, aSearchSubFolders)
1324 end else begin
1325 New(pNew);
1326 pNew^.FileName := srSearcher.Name;
1327 pNew^.UCFileName := UpperCase(pNew^.FileName);
1328 pNew^.Folder := pNewFolder;
1329 pNew^.Size := srSearcher.Size;
1330 pNew^.LastModified := FileDateToDateTime(srSearcher.Time);
1331 pNew^.SearchMatch := False;
1332 pNew^.Next := pKnownFiles;
1333 pNew^.NextMatch := nil;
1334 pKnownFiles := pNew;
1335 inc(iKnownFileCount);
1336 end;
1337
1338 if (iKnownFileCount mod 1000) = 0 then begin
1339 pnlDiscovering.Caption := 'Discovering
1340Files...('at('###,###,###,##0', iKnownFileCount)+')';
1341 pnlDiscovering.Refresh;
1342 end;
1343
1344 until FindNext(srSearcher) <> 0;
1345 FindClose(srSearcher);
1346 end;
1347end;
1348
1349
1350procedure TfrmHereMain.ClearAllListsAndCounts;
1351var
1352 i: Integer;
1353begin
1354 tsLocate.TabVisible := False;
1355 tsStatistics.TabVisible := False;
1356 iKnownFileCount := 0;
1357 ClearFileList(pKnownFiles);
1358 ClearFolderList(pKnownFolders);
1359 for i := 0 to 99 do begin
1360 aryFoldersByFileCount[i] := nil;
1361 aryFoldersByFileSize[i] := nil;
1362 end;
1363end;
1364
1365function TfrmHereMain.GetNodePath(var aNode: TTreeNode): string;
1366var
1367 nCurrNode: TTreeNode;
1368begin
1369 result := '';
1370 nCurrNode := aNode;
1371 while nCurrNode <> nil do begin
1372 result := Trim(nCurrNode.Text) + '\' +result;
1373 nCurrNode := nCurrNode.Parent;
1374 end;
1375end;
1376
1377procedure TfrmHereMain.LearnFilesInNode(var aNode: TTreeNode);
1378var
1379 nChild: TTreeNode;
1380begin
1381 if (aNode.Data = oChecked) or ((aNode.Data = oPartiallyChecked) and
1382(cbxIncludeParent.Checked)) then
1383 LearnFilesInFolder(GetNodePath(aNode));
1384
1385 if (aNode.Data = oChecked) or (aNode.Data = oPartiallyChecked) then begin
1386 {Traverse children}
1387 nChild := aNode.GetFirstChild;
1388 while nChild <> nil do begin
1389 LearnFilesInNode(nChild);
1390 nChild := nChild.getNextSibling;
1391 end;
1392 end;
1393end;
1394
1395procedure TfrmHereMain.LearnFilesInFolder(aFolder: string);
1396var
1397 srSearcher: TSearchRec;
1398 sFolder: string;
1399 pNew: TFilePtr;
1400 pNewFolder: TFolderPtr;
1401begin
1402 aFolder := Trim(aFolder);
1403 if aFolder[Length(aFolder)] <> '\' then aFolder := aFolder + '\';
1404
1405 New(pNewFolder);
1406 pNewFolder^.Folder := aFolder;
1407 pNewFolder^.FileCount := 0;
1408 pNewFolder^.TotalFileSize := 0;
1409 pNewFolder^.Next := pKnownFolders;
1410 pKnownFolders := pNewFolder;
1411
1412 sFolder := aFolder + '*.*';
1413 if FindFirst(sFolder, faAnyFile, srSearcher) = 0 then begin
1414 repeat
1415 if (srSearcher.Attr and faDirectory) = 0 then begin
1416 New(pNew);
1417 pNew^.FileName := srSearcher.Name;
1418 pNew^.UCFileName := UpperCase(pNew^.FileName);
1419 pNew^.Folder := pNewFolder;
1420 pNew^.Size := srSearcher.Size;
1421 pNew^.LastModified := FileDateToDateTime(srSearcher.Time);
1422 pNew^.SearchMatch := False;
1423 pNew^.Next := pKnownFiles;
1424 pNew^.NextMatch := nil;
1425 pKnownFiles := pNew;
1426 inc(iKnownFileCount);
1427 end;
1428
1429 if (iKnownFileCount mod 1000) = 0 then begin
1430 pnlDiscovering.Caption := 'Discovered ' + FormatFloat('###,###,###,##0',
1431iKnownFileCount) + ' Files';
1432 pnlDiscovering.Refresh;
1433 end;
1434
1435 until FindNext(srSearcher) <> 0;
1436 FindClose(srSearcher);
1437 end;
1438end;
1439
1440procedure TfrmHereMain.SetLearnButtonAccessability;
1441var
1442 iRootNodesChecked: Integer;
1443 nRootNode: TTreeNode;
1444begin
1445 iRootNodesChecked := 0;
1446 nRootNode := TreeView1.Items.GetFirstNode;
1447 while nRootNode <> nil do begin
1448 if nRootNode.Data <> nil then begin
1449 inc(iRootNodesChecked);
1450 break;
1451 end else
1452 nRootNode := nRootNode.getNextSibling;
1453 end;
1454 btnDiscoverFolders.Enabled := (iRootNodesChecked > 0);
1455 btnLearnFilesNow.Enabled := (iRootNodesChecked > 0);
1456 cbxIncludeParent.Enabled := (iRootNodesChecked > 0);
1457end;
1458
1459procedure TfrmHereMain.sgMatchesMouseUp(Sender: TObject;
1460 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1461var
1462 Column, Row: Longint;
1463begin
1464 if Button = mbLeft then begin
1465 sgMatches.MouseToCell(X, Y, Column, Row);
1466 if Row = 0 then
1467 SortResults(Column);
1468 end;
1469end;
1470
1471procedure TfrmHereMain.SortResults(aColumn: Integer);
1472var
1473 pSelected: TFilePtr;
1474begin
1475 if aColumn = iResultsSortByCol then
1476 bResultSortAscending := not bResultSortAscending;
1477 iResultsSortByCol := aColumn;
1478
1479
1480 lblMatchCount.Caption := 'sorting...';
1481 lblMatchCount.Refresh;
1482 sgMatches.Visible := False;
1483
1484 pSelected := nil;
1485 if sgMatches.Row > 0 then
1486 pSelected := TFilePtr(sgMatches.Objects[0, sgMatches.Row]);
1487
1488 PerformSort(iResultsSortByCol, bResultSortAscending);
1489 DisplaySearchResults;
1490
1491 SelectRowByObject(pSelected);
1492
1493 sgMatches.Visible := True;
1494 edtSelectedMatch.Text := sgMatches.Cells[1, sgMatches.Row]+sgMatches.Cells[0,
1495sgMatches.Row];
1496 lblMatchCount.Caption := FormatFloat('###,###,##0', iMatchCount) + ' matches';
1497end;
1498
1499
1500procedure TfrmHereMain.PerformSort(aColumn: Integer; aAscending: Boolean);
1501var
1502 pElem1, pElem2, pPrefix, pOrigin: TFilePtr;
1503 bChanged, SwitchElems: boolean;
1504begin
1505 {This proc sorts the entire list of files(not just the search matches),
1506 based on a given grid column.}
1507 if (pKnownFiles = nil) then Exit; {can't sort 0 items!}
1508 if (pKnownFiles^.Next = nil) then Exit; {can't sort just 1 item!}
1509
1510
1511 {Create a temporary new origin for the list. This allows
1512 the first item to be treated the same as items 2..n.}
1513 New(pOrigin);
1514 pOrigin^.NextMatch := pMatches;
1515
1516 bChanged := True;
1517 while bChanged do begin
1518
1519 bChanged := False;
1520 pPrefix := pOrigin;
1521
1522 while (pPrefix <> nil) do begin
1523
1524 pElem1 := pPrefix^.NextMatch;
1525 if pElem1 = nil then break;
1526 pElem2 := pElem1^.NextMatch;
1527 if pElem2 = nil then break;
1528 SwitchElems := False;
1529
1530 if aAscending then begin
1531 case aColumn of
1532 0: SwitchElems := (_StrComp(pElem1^.UCFileName, pElem2^.UCFileName) > 0);
1533{file name}
1534 1: SwitchElems := (_StrComp(pElem1^.Folder^.UCFolder ,
1535pElem2^.Folder^.UCFolder) > 0); {folder}
1536 2: SwitchElems := (pElem1^.Size > pElem2^.Size); {Size}
1537 3: SwitchElems := (pElem1^.LastModified > pElem2^.LastModified); {last
1538modified}
1539 end;
1540 end else begin
1541 case aColumn of
1542 0: SwitchElems := (_StrComp(pElem1^.UCFileName, pElem2^.UCFileName) < 0);
1543{file name}
1544 1: SwitchElems := (_StrComp(pElem1^.Folder^.UCFolder ,
1545pElem2^.Folder^.UCFolder) < 0); {folder}
1546 2: SwitchElems := (pElem1^.Size < pElem2^.Size); {Size}
1547 3: SwitchElems := (pElem1^.LastModified < pElem2^.LastModified); {last
1548modified}
1549 end;
1550 end;
1551
1552 if SwitchElems then begin
1553 bChanged := True;
1554 pElem1^.NextMatch := pElem2^.NextMatch;
1555 pElem2^.NextMatch := pElem1;
1556 pPrefix^.NextMatch := pElem2;
1557 end;
1558
1559 pPrefix := pPrefix^.NextMatch;
1560
1561 end; {while (pSortPrefix...}
1562
1563 end; {while bChanged...}
1564 pMatches := pOrigin^.NextMatch;
1565 Dispose(pOrigin);
1566end;
1567
1568procedure TfrmHereMain.SelectRowByObject(var aSelected: TFilePtr);
1569var
1570 iRow: Integer;
1571begin
1572 for iRow := 1 to (sgMatches.RowCount - 1) do
1573 if TFilePtr(sgMatches.Objects[0, iRow]) = aSelected then begin
1574 sgMatches.Row := iRow;
1575 Exit;
1576 end;
1577end;
1578
1579function _StrComp(var aStr1, aStr2: string): Integer;
1580var
1581 iChar, iLen1, iLen2: Integer;
1582begin
1583 result := 0;
1584 {Get the length of the shorter of the two strings}
1585 iLen1 := Length(aStr1);
1586 iLen2 := Length(aStr2);
1587
1588 if (iLen1 < iLen2) and (iLen1 = 0) then result := -1;
1589 if (iLen2 < iLen1) and (iLen2 = 0) then result := 1;
1590
1591 if result <> 0 then Exit;
1592
1593 if iLen1 > iLen2 then iLen1 := iLen2; {store minimum length in iLen1}
1594
1595 iChar := 1;
1596 while (iChar <= iLen1) and (result = 0) do begin
1597 Result := (Ord(aStr1[iChar]) - Ord(aStr2[iChar]));
1598 inc(iChar);
1599 end;
1600
1601 if result = 0 then
1602 if Length(aStr1) > Length(aStr2) then
1603 result := 1
1604 else
1605 if Length(aStr1) < Length(aStr2) then
1606 result := -1;
1607end;
1608
1609end.
|
