Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to create a Desktop Search Tool Part 1 Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
Desktop Search Tool 09-Jan-05
Category
Files Operation
Language
Delphi All Versions
Views
635
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
Wray, Terry
Reference URL:
Here Desktop Search Tool
			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.
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC