Mega Code Archive
How to create a desktop search tool part 1
<![CDATA[
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.
{
Issues:
--------
- Sorting starts to get kind of slow with > 3000 items
- Consider implementing the max/min bubble-sort enhancement
- More internal docs needed
Wish-List:
----------
- A good book, a glass of scotch and a warm breeze to fill my sails
History:
------------
Oct 29/04
- Began development
Nov 05/04
- Changed the Matches list box to a grid for ease of reading
- Added the Size and Last Modified columns to the Matches grid
- Added the asterisk wildcard to the search box
- Consolidated the folder list to reduce the memory footprint
Nov 09/04
- Implemented the Statistics page
- Implemented the File Sizes statistics page
Nov 10/04
- Implemented the Folders statistics page
- Implemented the Modifications statistics page
- Enhanced the CompareToSearchPhrase function so it handles >1 wildcard
Nov 11/04
- Fixed a bug in the CompareToSearchPhrase function
- Fixed several bugs relating to statistical graphing
- Added a check to keep folders from being added if their parent already includes them
Nov 12/04
- Added the "By Size" and "By Modified Time" search range options
- Removed the "Last Modified File" display from the Modifications statistics page
Nov 17/04
- Implemented a prototype of a TreeView-based directory selection page
- Implemented auto-drive discovery for the TreeView
- Implemented structure discovery for the selected drives of the TreeView
Nov 19/04
- Implemented file discovery for the tree view
- Remove all the list-based learning controls & methods
- Implemented the Match/Doesn't Match checkbox for search by filename
Nov 22/04
- Fixed a bug that kept files from being learned if the the folders weren't discovered first
- Moved the scales to the left side of graphs, keeping the values on the right side
Nov 24/04
- Added single-char wildcard searches (and made searching much cleaner) with donated code
from Ritchie Annand.
Nov 26/04
- Minor esthetic adjustment to labels on the Statistics pages.
- Move the amounts to the left side of the Folder Statistics lists.
- Began working on the click-results-column-to-sort functionality
Nov 29/04
- Got bubble sort working (Ascending only) for the results grid.
Nov 30/04
- Got the Ascending/Descending toggle to work on the search result sort
- Allowed the selected item to be maintained during sorting
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, FileCtrl, Grids, ExtCtrls, ComCtrls;
{Information on each folder is stored in one of these records.}
{There are stored in a separate linked-list and pointed to by the Folder attrib
of TFilePtr. This saves the space used by storing the folder info which each
file.}
type
TFolderPtr = ^TFolderElem;
TFolderElem = record
Folder: string;
UCFolder: string; {Upper-case folder name. Increases sorting efficiency.}
FileCount: Integer; {used on the Statistics pages.}
TotalFileSize: Int64; {used on the Statistics pages.}
Next: TFolderPtr;
end;
{Information on each file is stored in one of these records.}
type
TFilePtr = ^TFileElem;
TFileElem = record
FileName: string;
UCFileName: string; {Upper-case file name. Increases sorting efficiency.}
Folder: TFolderPtr;
Size: Integer;
LastModified: TDateTime;
SearchMatch: Boolean; {...True, if this item matches the search criteria.}
Next: TFilePtr; {...points to the next item, in natural order.}
NextMatch: TFilePtr; {...points to the next item matching the search criteria.
These links are used in the sorting routines.}
end;
type
TfrmHereMain = class(TForm)
pgcMain: TPageControl;
tsLocate: TTabSheet;
pnlLocateControls: TPanel;
Label1: TLabel;
edtFileName: TEdit;
btnCopyFullPath: TButton;
edtSelectedMatch: TEdit;
lblMatchCount: TLabel;
sgMatches: TStringGrid;
tsStatistics: TTabSheet;
pgcStatistics: TPageControl;
tsFileSizes: TTabSheet;
tsFolders: TTabSheet;
tsModifications: TTabSheet;
Panel2: TPanel;
Label4: TLabel;
lblLargestFileName: TLabel;
Label6: TLabel;
lblLargestFileSize: TLabel;
Label8: TLabel;
Label5: TLabel;
lblLargestFileFolder: TLabel;
lblAverageFileSize: TLabel;
Label7: TLabel;
lblTotalFiles: TLabel;
pbxFileSizes: TPaintBox;
Panel4: TPanel;
Label9: TLabel;
lblFoldersByFileCount: TLabel;
Panel5: TPanel;
lblFoldersByFileSize: TLabel;
lbxFoldersByFileCount: TListBox;
lbxFoldersByFileSize: TListBox;
lblFolderCount: TLabel;
Splitter1: TSplitter;
pbxFileMods: TPaintBox;
ckbSearchByFileName: TCheckBox;
ckbSearchBySize: TCheckBox;
ckbSearchByModTime: TCheckBox;
edtSizeAmount: TEdit;
edtModAmount: TEdit;
cbxModUnits: TComboBox;
btnSearch: TButton;
cbxSizeUnits: TComboBox;
edtModAmount2: TEdit;
cbxModUnits2: TComboBox;
ckbSearchByModTimeTo: TCheckBox;
edtSizeAmount2: TEdit;
cbxSizeUnits2: TComboBox;
Label3: TLabel;
tsLearn: TTabSheet;
Panel1: TPanel;
TreeView1: TTreeView;
btnDiscoverFolders: TButton;
btnLearnFilesNow: TButton;
btnWhyDiscoverFolders: TButton;
cbxIncludeParent: TCheckBox;
pnlDiscovering: TPanel;
Panel3: TPanel;
Label2: TLabel;
cbxFileNameMatchType: TComboBox;
procedure btnCopyFullPathClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure sgMatchesSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure sgMatchesDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure tsFileSizesShow(Sender: TObject);
procedure pbxFileSizesPaint(Sender: TObject);
procedure tsFoldersShow(Sender: TObject);
procedure tsModificationsShow(Sender: TObject);
procedure pbxFileModsPaint(Sender: TObject);
procedure edtSizeAmountKeyPress(Sender: TObject; var Key: Char);
procedure btnSearchClick(Sender: TObject);
procedure edtSizeAmountExit(Sender: TObject);
procedure ckbSearchByModTimeClick(Sender: TObject);
procedure edtSizeAmount2Exit(Sender: TObject);
procedure TreeView1CustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure TreeView1Addition(Sender: TObject; Node: TTreeNode);
procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TreeView1KeyPress(Sender: TObject; var Key: Char);
procedure TreeView1Collapsing(Sender: TObject; Node: TTreeNode;
var AllowCollapse: Boolean);
procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
procedure btnDiscoverFoldersClick(Sender: TObject);
procedure btnWhyDiscoverFoldersClick(Sender: TObject);
procedure btnLearnFilesNowClick(Sender: TObject);
procedure sgMatchesMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
bResultSortAscending, bExpanding, bCollapsing, bFilesHaveBeenLearned,
bCustomDraw: Boolean;
sLargestFileName: string;
iKnownFolderCount, iKnownFileCount, iResultsSortByCol, iAverageFileSizeCount,
iLargestFileSize, iFolderCount: Integer;
iMatchCount, iAverageFileSizeTotal, iSizeFloor, iSizeCeiling: Int64;
dModTimeFloor, dModTimeCeiling: Double;
pKnownFiles, pMatches: TFilePtr;
pKnownFolders: TFolderPtr;
aryFileSizes, aryModDaysAgo: array[0..12] of Integer;
aryFoldersByFileCount, aryFoldersByFileSize: array[0..99] of TFolderPtr;
oChecked, oPartiallyChecked: TObject;
function AllDescendantsAreChecked(aParent: TTreeNode): Boolean;
procedure BuildDriveList(var aList: TStringList);
procedure BuildRecursiveFileList(aFolder: string; aSearchSubFolders: Boolean);
procedure CheckTopFoldersByFileCount(var aFolder: TFolderPtr);
procedure CheckTopFoldersByFileSize(var aFolder: TFolderPtr);
procedure ClearAllListsAndCounts;
procedure ClearFileList(var aList: TFilePtr);
procedure ClearFolderList(var aList: TFolderPtr);
procedure ClearResultsGrid;
procedure ClearSearchMatches(var aList: TFilePtr);
procedure DiscoverRootNodeFolders;
procedure DisplaySearchResults;
procedure DrawFileModChart;
procedure DrawFileSizeChart;
procedure FolderToTreeNodes(aFolder: string; aParentNode: TTreeNode);
procedure GatherStatistics;
function GetNodePath(var aNode: TTreeNode): string;
procedure HandleNodeClick(aNode: TTreeNode);
procedure InformChildNodes(aNode: TTreeNode);
procedure InformParentNode(aParent: TTreeNode; aChecked: Boolean);
procedure LearnFilesInFolder(aFolder: string);
procedure LearnFilesInNode(var aNode: TTreeNode);
procedure LinkMatches;
procedure LoadDriveNodes;
procedure PerformLocate;
procedure PerformSort(aColumn: Integer; aAscending: Boolean);
procedure SelectRowByObject(var aSelected: TFilePtr);
procedure SetGridColWidths;
procedure SetLearnButtonAccessability;
procedure SortResults(aColumn: Integer);
public
end;
var
frmHereMain: TfrmHereMain;
function Matches(const ASource, APattern: string; ACaseSensitive: Boolean=False): Boolean;
function _StrComp(var aStr1, aStr2: string): Integer;
implementation
{$R *.dfm}
procedure TfrmHereMain.PerformLocate;
var
pElem: TFilePtr;
sSearchPhrase: string;
bMeetsCriteria: Boolean;
dtNow: TDateTime;
begin
sgMatches.Visible := False;
ClearResultsGrid;
dtNow := Now;
sSearchPhrase := UpperCase(Trim(edtFileName.Text));
btnSearch.Enabled := False;
btnCopyFullPath.Enabled := False;
lblMatchCount.Caption := 'searching...';
lblMatchCount.Refresh;
ClearSearchMatches(pKnownFiles);
pElem := pKnownFiles;
iMatchCount := 0;
while pElem <> nil do begin
bMeetsCriteria := True;
if ckbSearchBySize.Checked then
bMeetsCriteria := (pElem^.Size >= iSizeFloor) and (pElem^.Size <= iSizeCeiling);
if bMeetsCriteria and ckbSearchByModTime.Checked then begin
bMeetsCriteria := ((dtNow - dModTimeCeiling) <= pElem^.LastModified);
if bMeetsCriteria and ckbSearchByModTimeTo.Checked then
bMeetsCriteria := ((dtNow - dModTimeFloor) >= pElem^.LastModified);
end;
if bMeetsCriteria and ckbSearchByFileName.Checked then
bMeetsCriteria := Matches(pElem^.UCFileName, sSearchPhrase, false) xor (cbxFileNameMatchType.ItemIndex = 1);
if bMeetsCriteria then begin
pElem^.SearchMatch := True;
inc(iMatchCount);
end;
pElem := pElem^.Next;
end;
LinkMatches;
DisplaySearchResults;
sgMatches.Row := 1;
edtSelectedMatch.Text := sgMatches.Cells[1, sgMatches.Row]+sgMatches.Cells[0, sgMatches.Row];
btnCopyFullPath.Enabled := (iMatchCount > 0);
btnSearch.Enabled := True;
sgMatches.Visible := True;
end;
procedure TfrmHereMain.LinkMatches;
var
pLastMatch, pSearcher: TFilePtr;
bFirstMatch: Boolean;
begin
{This proc connects the search results via their NextMatch attrib.}
bFirstMatch := True;
pSearcher := pKnownFiles;
while pSearcher <> nil do begin
if pSearcher^.SearchMatch then begin
if bFirstMatch then begin
pMatches := pSearcher;
bFirstMatch := False;
end;
if pLastMatch <> nil then
pLastMatch^.NextMatch := pSearcher;
pLastMatch := pSearcher;
end;
pSearcher := pSearcher^.Next;
end;
end;
procedure TfrmHereMain.ClearSearchMatches(var aList: TFilePtr);
var
pElem: TFilePtr;
begin
{This proc undoes any evidence that any items ever matched the search criteria.}
pElem := aList;
while pElem <> nil do begin
pElem^.SearchMatch := False;
pElem^.NextMatch := nil;
pElem := pElem^.Next;
end;
end;
procedure TfrmHereMain.ClearResultsGrid;
begin
lblMatchCount.Caption := '';
with sgMatches do begin
while RowCount > 2 do begin
Objects[0, RowCount-1] := nil;
Rows[RowCount-1].Clear;
RowCount := RowCount - 1;
end;
Rows[1].Clear;
end;
end;
procedure TfrmHereMain.DisplaySearchResults;
var
iRow: Integer;
pElem: TFilePtr;
sFileSize: string;
begin
ClearResultsGrid;
pElem := pMatches;
while pElem <> nil do
with sgMatches do begin
if pElem^.SearchMatch then begin
if Cells[0,1] <> '' then RowCount := RowCount + 1;
iRow := RowCount - 1;
Cells[0, iRow] := pElem^.FileName;
Cells[1, iRow] := pElem^.Folder^.Folder;
sFileSize := FormatFloat('###,###,###,##0', Round(pElem^.Size/1024))+' KB';
Cells[2, iRow] := sFileSize;
Cells[3, iRow] := FormatDateTime('MM/DD/YYYY HH:NN', pElem^.LastModified);
Objects[0, iRow] := TObject(pElem);
end;
pElem := pElem^.NextMatch;
end;
lblMatchCount.Caption := FormatFloat('###,###,##0', iMatchCount) + ' matches';
end;
function Matches(const ASource, APattern: string;
ACaseSensitive: Boolean=False): Boolean;
{This function was donated by Ritchie Annand.}
function MatchPattern(ASourcePart, APatternPart: PChar): Boolean;
begin
if StrComp(APatternPart,'*')=0 then
Result := True // * matches everything
else if ASourcePart^=#0 then // end of the string
Result := APatternPart^=#0 // is there still pattern remaining?
else
case APatternPart^ of
'*' :
if MatchPattern(ASourcePart,APatternPart+1) then
Result := True
else
Result := MatchPattern(ASourcePart+1,APatternPart);
'?' :
Result := MatchPattern(ASourcePart+1,APatternPart+1);
else
if ACaseSensitive then
if ASourcePart^=APatternPart^ then
Result := MatchPattern(ASourcePart+1,APatternPart+1)
else
Result := False
else
if Upcase(ASourcePart^)=Upcase(APatternPart^) then
Result := MatchPattern(ASourcePart+1,APatternPart+1)
else
Result := False;
end;
end;
begin
Result := MatchPattern(PChar(ASource),PChar(APattern));
end;
procedure TfrmHereMain.btnCopyFullPathClick(Sender: TObject);
begin
edtSelectedMatch.SelectAll;
edtSelectedMatch.CopyToClipboard;
end;
procedure TfrmHereMain.FormCreate(Sender: TObject);
begin
bFilesHaveBeenLearned := False;
pKnownFiles := nil;
pKnownFolders := nil;
pKnownFolders := nil;
bCustomDraw := True;
oChecked := TObject.Create;
oPartiallyChecked := TObject.Create;
bExpanding := False;
bCollapsing := False;
iKnownFolderCount := 0;
end;
procedure TfrmHereMain.FormDestroy(Sender: TObject);
begin
ClearFileList(pKnownFiles);
ClearFolderList(pKnownFolders);
pKnownFiles := nil;
pKnownFolders := nil;
oChecked.Free;
oPartiallyChecked.Free;
end;
procedure TfrmHereMain.ClearFileList(var aList: TFilePtr);
var
pKiller: TFilePtr;
begin
pKiller := aList;
while pKiller <> nil do begin
aList := aList^.Next;
Dispose(pKiller);
pKiller := aList;
end;
end;
procedure TfrmHereMain.ClearFolderList(var aList: TFolderPtr);
var
pKiller: TFolderPtr;
begin
pKiller := aList;
while pKiller <> nil do begin
aList := aList^.Next;
Dispose(pKiller);
pKiller := aList;
end;
end;
procedure TfrmHereMain.FormResize(Sender: TObject);
begin
pnlDiscovering.Left := Trunc((Width/2)-(pnlDiscovering.Width/2));
pnlDiscovering.Top := Trunc((Height/2)-(pnlDiscovering.Height/2));
SetGridColWidths;
edtFileName.Width := (pnlLocateControls.Width - 30) - edtFileName.Left;
btnSearch.Left := Round((pnlLocateControls.Width/2) - Round(btnSearch.Width/2));
lblMatchCount.Left := (pnlLocateControls.Width - lblMatchCount.Width) - 3;
end;
procedure TfrmHereMain.SetGridColWidths;
begin
with sgMatches do begin
ColWidths[0] := Trunc(sgMatches.Width * 0.27);
ColWidths[1] := Trunc(sgMatches.Width * 0.37);
ColWidths[2] := Trunc(sgMatches.Width * 0.10);
ColWidths[3] := Trunc(sgMatches.Width * 0.22);
end;
end;
procedure TfrmHereMain.FormShow(Sender: TObject);
begin
pgcMain.ActivePageIndex := 0;
pgcStatistics.ActivePageIndex := 0;
tsLocate.TabVisible := False;
tsStatistics.TabVisible := False;
sgMatches.Cells[0,0] := 'File';
sgMatches.Cells[1,0] := 'Folder';
sgMatches.Cells[2,0] := 'Size';
sgMatches.Cells[3,0] := 'Last Modified';
SetGridColWidths;
TreeView1.Items.Clear;
LoadDriveNodes;
end;
procedure TfrmHereMain.sgMatchesSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
edtSelectedMatch.Text := sgMatches.Cells[1, ARow]+sgMatches.Cells[0, ARow];
end;
procedure TfrmHereMain.sgMatchesDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
iTextWidth: Integer;
begin
if (aCol = 2) {Size} then begin
{ determine the width the text will be, when displayed }
iTextWidth := sgMatches.Canvas.TextExtent(sgMatches.Cells[ACol, ARow]).cx;
{ right justify the column text by re-drawing it manually }
sgMatches.Canvas.TextRect(Rect, Rect.right - iTextWidth - 3,Rect.Top+2, sgMatches.Cells[ACol, ARow]);
end;
end;
procedure TfrmHereMain.GatherStatistics;
var
pEye: TFilePtr;
pFolder: TFolderPtr;
i: Integer;
begin
iLargestFileSize := 0;
sLargestFileName := '';
for i := 0 to 12 do aryFileSizes[i] := 0;
for i := 0 to 12 do aryModDaysAgo[i] := 0;
pEye := pKnownFiles;
while pEye <> nil do begin
{Largest File Size}
if pEye^.Size > iLargestFileSize then begin
iLargestFileSize := pEye^.Size;
sLargestFileName := pEye^.Folder^.Folder+pEye^.FileName;
end;
{File Size graph}
case pEye^.Size of
0..512: inc(aryFileSizes[0]);
513..1024: inc(aryFileSizes[1]);
1025..2048: inc(aryFileSizes[2]);
2049..4096: inc(aryFileSizes[3]);
4099..8192: inc(aryFileSizes[4]);
8193..16384: inc(aryFileSizes[5]);
16385..32768: inc(aryFileSizes[6]);
32769..65536: inc(aryFileSizes[7]);
65537..131072: inc(aryFileSizes[8]);
131073..262144: inc(aryFileSizes[9]);
262145..524288: inc(aryFileSizes[10]);
524289..1048576: inc(aryFileSizes[11]);
else
inc(aryFileSizes[12]);
end;
{File Modifications graph}
case Round((Now-pEye^.LastModified)+1) of
0..1: inc(aryModDaysAgo[0]);
2: inc(aryModDaysAgo[1]);
3: inc(aryModDaysAgo[2]);
4: inc(aryModDaysAgo[3]);
5: inc(aryModDaysAgo[4]);
6: inc(aryModDaysAgo[5]);
7: inc(aryModDaysAgo[6]);
8..30: inc(aryModDaysAgo[7]); {1 week - 1 mo}
31..183: inc(aryModDaysAgo[8]); {1 mo - 6 mo}
184..365: inc(aryModDaysAgo[9]); {6 mo - 1 yr}
366..730: inc(aryModDaysAgo[10]); {1 yr - 2 yrs}
731..1096: inc(aryModDaysAgo[11]); {2 yrs - 3 yrs}
else
inc(aryModDaysAgo[12]); {3+ yrs}
end;
{Average File Size}
iAverageFileSizeTotal := iAverageFileSizeTotal + pEye^.Size;
inc(iAverageFileSizeCount);
{Folder File Count}
inc(pEye^.Folder^.FileCount);
{Folder File Size Total}
pEye^.Folder^.TotalFileSize := pEye^.Folder^.TotalFileSize + pEye^.Size;
pEye := pEye^.Next;
end;
{# of Folders}
iFolderCount := 0;
pFolder := pKnownFolders;
while pFolder <> nil do begin
inc(iFolderCount);
CheckTopFoldersByFileCount(pFolder);
CheckTopFoldersByFileSize(pFolder);
pFolder := pFolder^.Next;
end;
tsFileSizesShow(self);
tsFoldersShow(self);
tsModificationsShow(self);
end;
procedure TfrmHereMain.tsFileSizesShow(Sender: TObject);
begin
if not bFilesHaveBeenLearned then Exit;
lblTotalFiles.Caption := FormatFloat('###,###,###,###,##0', iKnownFileCount);
lblAverageFileSize.Caption := FormatFloat('###, ###, ###, ##0 KB', Round((iAverageFileSizeTotal/iAverageFileSizeCount)/1024));
lblLargestFileName.Caption := ExtractFileName(sLargestFileName);
lblLargestFileFolder.Caption := ExtractFilePath(sLargestFileName);
lblLargestFileSize.Caption := FormatFloat('###, ###, ###, ##0 KB', iLargestFileSize);
DrawFileSizeChart;
end;
procedure TfrmHereMain.DrawFileSizeChart;
const
aryBars: array[0..12] of PChar = ('0-0.5KB', '0.5-1KB', '1-2KB', '2-4KB',
'4-8KB', '8-16KB', '16-32KB', '32-64KB', '64-128KB', '128-256KB',
'256-512KB','512-1MB','1MB+');
var
iHighestCount, i, iX, iBarBottom, iBar, iBarThickness: Integer;
iScaleFactor: Double;
begin
iBarBottom := pbxFileSizes.Left + 60;
with pbxFileSizes.Canvas do begin
Pen.Style := psSolid;
Font.Size := 8;
iBarThickness := 13;
iHighestCount := 0;
for i := 0 to 12 do
if aryFileSizes[i] > iHighestCount then
iHighestCount := aryFileSizes[i];
iScaleFactor := iHighestCount/(pbxFileSizes.Width-125);
Pen.Color := clGray;
iX := 0;
for iBar := 0 to High(aryFileSizes) do begin
if Pen.Color = clNavy then
Pen.Color := clGray
else
Pen.Color := clNavy;
for i := (iBar*iBarThickness) to ((iBar*iBarThickness)+12) do begin
MoveTo(iBarBottom, i);
iX := iBarBottom + Round(aryFileSizes[iBar]/iScaleFactor);
LineTo(iX, i);
end;
{Legend}
Brush.Color := clBtnFace;
TextOut(2, (iBar*iBarThickness), aryBars[iBar]);
TextOut(iX+2, (iBar*iBarThickness), FormatFloat('###,###,##0', aryFileSizes[iBar]));
end;
end;
end;
procedure TfrmHereMain.pbxFileSizesPaint(Sender: TObject);
begin
tsFileSizesShow(Sender);
end;
procedure TfrmHereMain.tsFoldersShow(Sender: TObject);
var
i: Integer;
begin
if not bFilesHaveBeenLearned then Exit;
lblFolderCount.Caption := FormatFloat('###,###,##0', iFolderCount);
lbxFoldersByFileCount.Items.Clear;
lbxFoldersByFileSize.Items.Clear;
for i := 0 to 99 do
if aryFoldersByFileCount[i] <> nil then
lbxFoldersByFileCount.Items.Add(FormatFloat('###,###,##0', aryFoldersByFileCount[i]^.FileCount) + ' - ' + aryFoldersByFileCount[i]^.Folder);
lblFoldersByFileCount.Caption := 'Top ' + IntToStr(lbxFoldersByFileCount.Items.Count) + ' Folders (by File Count):';
for i := 0 to 99 do
if aryFoldersByFileSize[i] <> nil then
lbxFoldersByFileSize.Items.Add(FormatFloat('###,###,##0MB', aryFoldersByFileSize[i]^.TotalFileSize/1048576) + ' - ' + aryFoldersByFileSize[i]^.Folder);
lblFoldersByFileSize.Caption := 'Top ' + IntToStr(lbxFoldersByFileSize.Items.Count) + ' Folders (by File Size):';
end;
procedure TfrmHereMain.CheckTopFoldersByFileCount(var aFolder: TFolderPtr);
var
i, iFBFCIndex: Integer;
pHold: TFolderPtr;
aryTemp: array[0..99] of TFolderPtr;
begin
{ Clear the temp array }
for i := 0 to 99 do aryTemp[i] := nil;
pHold := aFolder;
iFBFCIndex := 0;
{ Insert pHold (aka aFolder) in the correct position, front & back-filled by the main array (aryFoldersByFileCount) }
for i := 0 to 99 do
if pHold = nil then begin
aryTemp[i] := aryFoldersByFileCount[iFBFCIndex];
inc(iFBFCIndex);
end else
if aryFoldersByFileCount[i]=nil then begin
aryTemp[i] := pHold;
pHold := nil;
end else
if pHold^.FileCount > aryFoldersByFileCount[i]^.FileCount then begin
aryTemp[i] := pHold;
pHold := nil;
end else begin
aryTemp[i] := aryFoldersByFileCount[iFBFCIndex];
inc(iFBFCIndex);
end;
{ Use the values from the temp array as the new main array }
for i := 0 to 99 do
aryFoldersByFileCount[i] := aryTemp[i];
end;
procedure TfrmHereMain.CheckTopFoldersByFileSize(var aFolder: TFolderPtr);
var
i, iFBFSIndex: Integer;
pHold: TFolderPtr;
aryTemp: array[0..99] of TFolderPtr;
begin
{ Clear the temp array }
for i := 0 to 99 do aryTemp[i] := nil;
pHold := aFolder;
iFBFSIndex := 0;
{ Insert pHold (aka aFolder) in the correct position, front & back-filled by the main array (aryFoldersByFileSize) }
for i := 0 to 99 do
if pHold = nil then begin
aryTemp[i] := aryFoldersByFileSize[iFBFSIndex];
inc(iFBFSIndex);
end else
if aryFoldersByFileSize[i]=nil then begin
aryTemp[i] := pHold;
pHold := nil;
end else
if pHold^.TotalFileSize > aryFoldersByFileSize[i]^.TotalFileSize then begin
aryTemp[i] := pHold;
pHold := nil;
end else begin
aryTemp[i] := aryFoldersByFileSize[iFBFSIndex];
inc(iFBFSIndex);
end;
{ Use the values from the temp array as the new main array }
for i := 0 to 99 do
aryFoldersByFileSize[i] := aryTemp[i];
end;
procedure TfrmHereMain.tsModificationsShow(Sender: TObject);
begin
if not bFilesHaveBeenLearned then Exit;
DrawFileModChart;
end;
procedure TfrmHereMain.DrawFileModChart;
const
aryBars: array[0..12] of PChar = ('0-1 days', '2 days', '3 days', '4 days',
'5 days', '6 days', '7 days', '8-30 days', '1-6 mo', '6 mo - 1 yr',
'1 - 2 yrs','2 - 3 yrs','3+ yrs');
var
iHighestCount, i, iX, iBarBottom, iBar, iBarThickness: Integer;
iScaleFactor: Double;
begin
iBarBottom := pbxFileMods.Left + 60;
with pbxFileMods.Canvas do begin
Pen.Style := psSolid;
Font.Size := 8;
iBarThickness := 13;
iHighestCount := 0;
for i := 0 to 12 do
if aryModDaysAgo[i] > iHighestCount then
iHighestCount := aryModDaysAgo[i];
iScaleFactor := iHighestCount/(pbxFileMods.Width-125);
Pen.Color := clGray;
iX := 0;
for iBar := 0 to High(aryModDaysAgo) do begin
if Pen.Color = clNavy then
Pen.Color := clGray
else
Pen.Color := clNavy;
for i := (iBar*iBarThickness) to ((iBar*iBarThickness)+12) do begin
MoveTo(iBarBottom, i);
iX := iBarBottom + Round(aryModDaysAgo[iBar]/iScaleFactor);
LineTo(iX, i);
end;
{Legend}
Brush.Color := clBtnFace;
TextOut(2, (iBar*iBarThickness), aryBars[iBar]);
TextOut(iX+2, (iBar*iBarThickness), FormatFloat('###,###,##0', aryModDaysAgo[iBar]));
end;
end;
end;
procedure TfrmHereMain.pbxFileModsPaint(Sender: TObject);
begin
tsModificationsShow(sender);
end;
procedure TfrmHereMain.edtSizeAmountKeyPress(Sender: TObject; var Key: Char);
begin
{ Only digits are allowed. #8 is back-space. }
if Pos(Key, '1234567890'+#8) = 0 then
Key := #0;
end;
procedure TfrmHereMain.btnSearchClick(Sender: TObject);
var
sTemp: string;
iTemp: Int64;
dTemp: Double;
begin
if ((not ckbSearchByFileName.Checked) and (not ckbSearchBySize.Checked) and (not ckbSearchByModTime.Checked)) then begin
MessageDlg('Please include at least one of the search methods using the check-boxes on the left.', mtInformation, [mbok], 0);
Exit;
end;
if ckbSearchByFileName.Checked then begin
if Length(Trim(edtFileName.Text)) < 3 then begin
MessageDlg('Please enter at least 3 characters for the file name pattern.', mtInformation, [mbok], 0);
edtFileName.SetFocus;
Exit;
end;
if Pos('**', Trim(edtFileName.Text)) > 0 then begin
MessageDlg('Wildcards(*) may not be adjacent to each other.'+#13#13+'eg. **A, A**, ***', mtInformation, [mbok], 0);
edtFileName.SetFocus;
Exit;
end;
end;
iSizeFloor := StrToInt(Trim(edtSizeAmount.Text));
case cbxSizeUnits.ItemIndex of
0: iSizeFloor := iSizeFloor*1024; {KBs}
1: iSizeFloor := iSizeFloor*1024*1024; {MBs}
2: iSizeFloor := iSizeFloor*1024*1024*1024; {GBs}
end;
iSizeCeiling := StrToInt(Trim(edtSizeAmount2.Text));
case cbxSizeUnits2.ItemIndex of
0: iSizeCeiling := iSizeCeiling*1024; {KBs}
1: iSizeCeiling := iSizeCeiling*1024*1024; {MBs}
2: iSizeCeiling := iSizeCeiling*1024*1024*1024; {GBs}
end;
if iSizeFloor > iSizeCeiling then begin
iTemp := iSizeFloor;
iSizeFloor := iSizeCeiling;
iSizeCeiling := iTemp;
end;
dModTimeCeiling := StrToInt(Trim(edtModAmount2.Text));
case cbxModUnits2.ItemIndex of
0: dModTimeCeiling := (dModTimeCeiling/24)/60; {Minutes}
1: dModTimeCeiling := dModTimeCeiling/24; {Hours}
2: dModTimeCeiling := dModTimeCeiling; {Days}
3: dModTimeCeiling := dModTimeCeiling*7; {Weeks}
4: dModTimeCeiling := dModTimeCeiling*365; {Years}
end;
dModTimeFloor := StrToInt(Trim(edtModAmount.Text));
case cbxModUnits.ItemIndex of
0: dModTimeFloor := (dModTimeFloor/24)/60; {Minutes}
1: dModTimeFloor := dModTimeFloor/24; {Hours}
2: dModTimeFloor := dModTimeFloor; {Days}
3: dModTimeFloor := dModTimeFloor*7; {Weeks}
4: dModTimeFloor := dModTimeFloor*365; {Years}
end;
if (ckbSearchByModTime.Checked and ckbSearchByModTimeTo.Checked) then
if dModTimeFloor > dModTimeCeiling then
if MessageDlg('Your modification time range values are inverted. Would you like to fix this and continue searching?', mtWarning, [mbYes, mbNo], 0) = mrYes then begin
sTemp := Trim(edtModAmount.Text);
edtModAmount.Text := Trim(edtModAmount2.Text);
edtModAmount2.Text := sTemp;
iTemp := cbxModUnits.ItemIndex;
cbxModUnits.ItemIndex := cbxModUnits2.ItemIndex;
cbxModUnits2.ItemIndex := iTemp;
dTemp := dModTimeFloor;
dModTimeFloor := dModTimeCeiling;
dModTimeCeiling := dTemp;
end else
Exit;
PerformLocate;
end;
procedure TfrmHereMain.ckbSearchByModTimeClick(Sender: TObject);
begin
ckbSearchByModTimeTo.Enabled := ckbSearchByModTime.Checked;
edtModAmount2.Enabled := ckbSearchByModTime.Checked;
cbxModUnits2.Enabled := ckbSearchByModTime.Checked;
end;
procedure TfrmHereMain.edtSizeAmountExit(Sender: TObject);
begin
{ Trim spaces }
TEdit(Sender).Text := Trim(TEdit(Sender).Text);
{ Don't allow blank }
if TEdit(Sender).Text = '' then TEdit(Sender).Text := '0'; {Zero is allowed}
{ Trim leading zeros }
while (TEdit(Sender).Text[1] = '0') and (Length(TEdit(Sender).Text) > 1) do
TEdit(Sender).Text := Copy(TEdit(Sender).Text, 2, Length(TEdit(Sender).Text));
{ Don't allow blank }
if TEdit(Sender).Text = '' then TEdit(Sender).Text := '0'; {Zero is allowed}
end;
procedure TfrmHereMain.edtSizeAmount2Exit(Sender: TObject);
begin
{ Trim spaces }
TEdit(Sender).Text := Trim(TEdit(Sender).Text);
{ Don't allow blank }
if TEdit(Sender).Text = '' then TEdit(Sender).Text := '1'; {Zero is not allowed}
{ Trim leading zeros }
while (TEdit(Sender).Text[1] = '0') and (Length(TEdit(Sender).Text) > 1) do
TEdit(Sender).Text := Copy(TEdit(Sender).Text, 2, Length(TEdit(Sender).Text));
{ Don't allow blank }
if TEdit(Sender).Text = '' then TEdit(Sender).Text := '1'; {Zero is not allowed}
end;
procedure TfrmHereMain.TreeView1CustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var
rRect, rBtnRect, rCheckBox: TRect;
nParent: TTreeNode;
procedure AdjustRectSize(var aRect: TRect; aAdjust: Integer);
begin
Dec(aRect.Left, aAdjust);
Dec(aRect.Top, aAdjust);
Inc(aRect.Right, aAdjust);
Inc(aRect.Bottom, aAdjust);
end;
procedure DrawExpansionButton(aRect: TRect);
begin
with TCustomTreeView(Sender).Canvas do begin
{Draw box}
Pen.Style := psSolid;
Pen.Color := clSilver;
Rectangle(aRect);
{Clear inner edge of box}
Pen.Color := clWhite;
AdjustRectSize(aRect, -1);
Rectangle(aRect);
{Draw plus/minus signs}
Pen.Color := clBlack;
AdjustRectSize(aRect, 1);
if Node.Expanded then begin
{Draw minus sign}
MoveTo(aRect.Left + 2, aRect.Top+4);
LineTo(aRect.Left + 7, aRect.Top+4);
end else begin
{Draw plus sign}
MoveTo(aRect.Left + 4, aRect.Top+2);
LineTo(aRect.Left + 4, aRect.Top+7);
MoveTo(aRect.Left + 2, aRect.Top+4);
LineTo(aRect.Left + 7, aRect.Top+4);
end;
end; {with}
end;
procedure DrawCheckBox(aRect: TRect);
var
iLine: Integer;
begin
with TCustomTreeView(Sender).Canvas do begin
Pen.Color := clSilver;
Rectangle(aRect);
if Node.Data <> nil then begin
{Draw checkmark}
if Node.Data = oChecked then
Pen.Color := clBlack {fully checked}
else
Pen.Color := clSilver; {partially checked & Partially checked include}
for iLine := 0 to 2 do begin
MoveTo(aRect.Left+2, aRect.Top+4+iLine);
LineTo(aRect.Left+4, aRect.Top+6+iLine);
LineTo(aRect.Left+9, aRect.Top+1+iLine);
end;
end;
end; {with}
end;
begin
DefaultDraw := not bCustomDraw;
if not bCustomDraw then Exit;
rRect := Node.DisplayRect(false);
rBtnRect := Rect(rRect.Left+5+(Node.Level*19), rRect.Top+4, rRect.Left+14+(Node.Level*19), rRect.Top+13);
with TCustomTreeView(Sender).Canvas do begin
Pen.Color := clSilver;
Pen.Style := psSolid;
{Line from button to text}
Pen.Color := clSilver;
MoveTo(rRect.Left+9+(Node.Level*19), rRect.Top+8);
LineTo(rRect.Left+18+(Node.Level*19), rRect.Top+8);
if not Node.IsFirstNode then begin
{All nodes, except the first, have a line from their center to the
one above, be it parent or sibling}
{Draw line from top of rect to middle}
MoveTo(rBtnRect.Left+4, rRect.Top);
LineTo(rBtnRect.Left+4, rRect.Top+Round((rRect.Bottom-rRect.Top)/2));
end;
if (Node.getNextSibling <> nil) then begin
{Node has a lower sibling}
{Draw line from middle this node to bottom of Rect}
MoveTo(rBtnRect.Left+4, rRect.Top+Round((rRect.Bottom-rRect.Top)/2));
LineTo(rBtnRect.Left+4, rRect.Bottom);
end;
nParent := Node.Parent;
while nParent <> nil do begin
if (nParent.getNextSibling <> nil) then begin
{Draw Ancestor Line Segments}
MoveTo(rRect.Left+9+(nParent.Level*TTreeView(Sender).Indent), rRect.Top);
LineTo(rRect.Left+9+(nParent.Level*TTreeView(Sender).Indent), rRect.Bottom);
end;
nParent := nParent.Parent;
end;
if Node.HasChildren then
DrawExpansionButton(rBtnRect);
rCheckBox := Rect(rBtnRect.Right+6, rRect.Top+3, rBtnRect.Right+17, rRect.Bottom-2);
DrawCheckBox(rCheckBox);
TextOut(rCheckBox.Right+2, rRect.Top+1, Node.Text);
end; {with}
end;
procedure TfrmHereMain.TreeView1Addition(Sender: TObject; Node: TTreeNode);
begin
{The portion of the node that captures click events starts with the check box,
but only extends as far as the length of the text. Since the text is shifted
to the right, spaces must be added to the end to ensure the the last few
characters are clickable.}
//tw - a more elegant fix is needed
Node.Text := Node.Text+' ';
Node.Data := nil;
end;
procedure TfrmHereMain.TreeView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if bCollapsing then begin
bCollapsing := False;
Exit;
end;
if bExpanding then begin
bExpanding := False;
Exit;
end;
HandleNodeClick(TTreeView(Sender).Selected);
end;
procedure TfrmHereMain.TreeView1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = ' ' then
HandleNodeClick(TTreeView(Sender).Selected);
end;
procedure TfrmHereMain.HandleNodeClick(aNode: TTreeNode);
begin
if aNode = nil then Exit;
if aNode.Data <> oChecked then
aNode.Data := oChecked
else
aNode.Data := nil;
if aNode.HasChildren then
InformChildNodes(aNode);
if aNode.Parent <> nil then
InformParentNode(aNode.Parent, (aNode.Data <> nil));
aNode.TreeView.Refresh;
SetLearnButtonAccessability;
end;
procedure TfrmHereMain.InformParentNode(aParent: TTreeNode; aChecked: Boolean);
begin
if aChecked then
if AllDescendantsAreChecked(aParent) then
aParent.Data := oChecked
else
aParent.Data := oPartiallyChecked
else
aParent.Data := oPartiallyChecked;
if aParent.Parent <> nil then
InformParentNode(aParent.Parent, (aParent.Data <> nil));
end;
function TfrmHereMain.AllDescendantsAreChecked(aParent: TTreeNode): Boolean;
var
nDescendant: TTreeNode;
begin
result := True;
nDescendant := aParent.getFirstChild;
while (nDescendant <> nil) and result do begin
if nDescendant.Data = nil then begin
result := False;
Break;
end;
if nDescendant.HasChildren then
result := AllDescendantsAreChecked(nDescendant);
nDescendant := aParent.GetNextChild(nDescendant);
end;
end;
procedure TfrmHereMain.InformChildNodes(aNode: TTreeNode);
var
nChild: TTreeNode;
begin
nChild := aNode.getFirstChild;
while nChild <> nil do begin
nChild.Data := aNode.Data;
if nChild.HasChildren then
InformChildNodes(nChild);
nChild := aNode.GetNextChild(nChild);
end;
end;
procedure TfrmHereMain.TreeView1Collapsing(Sender: TObject;
Node: TTreeNode; var AllowCollapse: Boolean);
begin
bCollapsing := True;
end;
procedure TfrmHereMain.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
begin
bExpanding := True;
end;
procedure TfrmHereMain.LoadDriveNodes;
var
slDrives: TStringList;
iFolder: Integer;
begin
slDrives := TStringList.Create;
BuildDriveList(slDrives);
for iFolder := 0 to (slDrives.Count - 1) do
TreeView1.Items.AddChild(nil, slDrives[iFolder]);
slDrives.Free;
end;
procedure TfrmHereMain.DiscoverRootNodeFolders;
var
nRootNode: TTreeNode;
begin
bFilesHaveBeenLearned := False;
pnlDiscovering.Caption := 'Discovering Folders...';
pnlDiscovering.visible := True;
pnlDiscovering.Refresh;
ClearAllListsAndCounts;
nRootNode := TreeView1.Items.GetFirstNode;
while nRootNode <> nil do begin
inc(iKnownFolderCount);
if nRootNode.Data = oChecked then begin
nRootNode.DeleteChildren;
FolderToTreeNodes(Trim(nRootNode.Text), nRootNode);
end;
nRootNode := nRootNode.getNextSibling;
end;
pnlDiscovering.visible := False;
end;
procedure TfrmHereMain.BuildDriveList(var aList: TStringList);
var
DriveNum: Integer;
DriveChar: Char;
DriveBits: set of 0..25;
begin
aList.Clear;
Integer(DriveBits) := GetLogicalDrives;
for DriveNum := 0 to 25 do
begin
if not (DriveNum in DriveBits) then Continue;
DriveChar := UpCase(Char(DriveNum + Ord('a')));
aList.Add(DriveChar+':');
end; {for}
end;
procedure TfrmHereMain.FolderToTreeNodes(aFolder: string; aParentNode: TTreeNode);
var
srSearcher: TSearchRec;
sFolder: string;
aNewNode: TTreeNode;
begin
sFolder := aFolder + '\*.*';
if FindFirst(sFolder, faDirectory, srSearcher) = 0 then begin
repeat
if (srSearcher.Attr and faDirectory) <> 0 then
if (srSearcher.Name <> '.') and (srSearcher.Name <> '..') then begin
aNewNode := TreeView1.Items.AddChild(aParentNode, srSearcher.Name);
aNewNode.Data := oChecked;
inc(iKnownFolderCount);
if (iKnownFolderCount mod 100) = 0 then begin
pnlDiscovering.Caption := 'Discovered ' + FormatFloat('###,###,###,##0',iKnownFolderCount) + ' Folders';
pnlDiscovering.Refresh;
end;
FolderToTreeNodes(aFolder + '\' + srSearcher.Name, aNewNode);
end;
until FindNext(srSearcher) <> 0;
FindClose(srSearcher);
end;
end;
procedure TfrmHereMain.btnDiscoverFoldersClick(Sender: TObject);
begin
if MessageDlg('This process may take a few minutes, especially if you''ve ' +
'selected any network drives.'+#13#13+'Would you like to proceed?',
mtConfirmation, [mbyes, mbno], 0) = mrYes then begin
iKnownFolderCount := 0;
DiscoverRootNodeFolders;
end;
end;
procedure TfrmHereMain.btnWhyDiscoverFoldersClick(Sender: TObject);
begin
MessageDlg('Why would I want to Discover Folders?' + #13#13 +
'Discovering the folders of the selected drives allows you to include/exclude ' +
'specific folders of these drives, rather than learning all the files on the ' +
'drive. However, the discovery process may take a few minutes. This process ' +
'may be considerably longer if you''ve selected any mapped network drives.',
mtInformation, [mbok], 0);
end;
procedure TfrmHereMain.btnLearnFilesNowClick(Sender: TObject);
var
nRootNode: TTreeNode;
begin
bFilesHaveBeenLearned := False;
pnlDiscovering.Caption := 'Discovering Files...';
pnlDiscovering.visible := True;
pnlDiscovering.Refresh;
frmHereMain.Enabled := False;
ClearAllListsAndCounts;
nRootNode := TreeView1.Items.GetFirstNode;
while nRootNode <> nil do begin
if nRootNode.Data <> nil then
if nRootNode.HasChildren then
LearnFilesInNode(nRootNode)
else
BuildRecursiveFileList(Trim(nRootNode.Text), True);
nRootNode := nRootNode.getNextSibling;
end;
GatherStatistics;
pnlDiscovering.visible := False;
frmHereMain.Enabled := True;
bFilesHaveBeenLearned := True;
tsLocate.TabVisible := True;
tsStatistics.TabVisible := True;
end;
procedure TfrmHereMain.BuildRecursiveFileList(aFolder: string; aSearchSubFolders: Boolean);
var
srSearcher: TSearchRec;
sFolder: string;
pNew: TFilePtr;
pNewFolder: TFolderPtr;
begin
if aFolder[Length(aFolder)] <> '\' then aFolder := aFolder + '\';
New(pNewFolder);
pNewFolder^.Folder := aFolder;
pNewFolder^.UCFolder := UpperCase(aFolder);
pNewFolder^.FileCount := 0;
pNewFolder^.TotalFileSize := 0;
pNewFolder^.Next := pKnownFolders;
pKnownFolders := pNewFolder;
sFolder := aFolder + '*.*';
if FindFirst(sFolder, faAnyFile, srSearcher) = 0 then begin
repeat
if (srSearcher.Attr and faDirectory) <> 0 then begin
if (srSearcher.Name <> '.') and (srSearcher.Name <> '..') and aSearchSubFolders then
BuildRecursiveFileList(aFolder + srSearcher.Name, aSearchSubFolders)
end else begin
New(pNew);
pNew^.FileName := srSearcher.Name;
pNew^.UCFileName := UpperCase(pNew^.FileName);
pNew^.Folder := pNewFolder;
pNew^.Size := srSearcher.Size;
pNew^.LastModified := FileDateToDateTime(srSearcher.Time);
pNew^.SearchMatch := False;
pNew^.Next := pKnownFiles;
pNew^.NextMatch := nil;
pKnownFiles := pNew;
inc(iKnownFileCount);
end;
if (iKnownFileCount mod 1000) = 0 then begin
pnlDiscovering.Caption := 'Discovering Files...('+FormatFloat('###,###,###,##0', iKnownFileCount)+')';
pnlDiscovering.Refresh;
end;
until FindNext(srSearcher) <> 0;
FindClose(srSearcher);
end;
end;
procedure TfrmHereMain.ClearAllListsAndCounts;
var
i: Integer;
begin
tsLocate.TabVisible := False;
tsStatistics.TabVisible := False;
iKnownFileCount := 0;
ClearFileList(pKnownFiles);
ClearFolderList(pKnownFolders);
for i := 0 to 99 do begin
aryFoldersByFileCount[i] := nil;
aryFoldersByFileSize[i] := nil;
end;
end;
function TfrmHereMain.GetNodePath(var aNode: TTreeNode): string;
var
nCurrNode: TTreeNode;
begin
result := '';
nCurrNode := aNode;
while nCurrNode <> nil do begin
result := Trim(nCurrNode.Text) + '\' +result;
nCurrNode := nCurrNode.Parent;
end;
end;
procedure TfrmHereMain.LearnFilesInNode(var aNode: TTreeNode);
var
nChild: TTreeNode;
begin
if (aNode.Data = oChecked) or ((aNode.Data = oPartiallyChecked) and (cbxIncludeParent.Checked)) then
LearnFilesInFolder(GetNodePath(aNode));
if (aNode.Data = oChecked) or (aNode.Data = oPartiallyChecked) then begin
{Traverse children}
nChild := aNode.GetFirstChild;
while nChild <> nil do begin
LearnFilesInNode(nChild);
nChild := nChild.getNextSibling;
end;
end;
end;
procedure TfrmHereMain.LearnFilesInFolder(aFolder: string);
var
srSearcher: TSearchRec;
sFolder: string;
pNew: TFilePtr;
pNewFolder: TFolderPtr;
begin
aFolder := Trim(aFolder);
if aFolder[Length(aFolder)] <> '\' then aFolder := aFolder + '\';
New(pNewFolder);
pNewFolder^.Folder := aFolder;
pNewFolder^.FileCount := 0;
pNewFolder^.TotalFileSize := 0;
pNewFolder^.Next := pKnownFolders;
pKnownFolders := pNewFolder;
sFolder := aFolder + '*.*';
if FindFirst(sFolder, faAnyFile, srSearcher) = 0 then begin
repeat
if (srSearcher.Attr and faDirectory) = 0 then begin
New(pNew);
pNew^.FileName := srSearcher.Name;
pNew^.UCFileName := UpperCase(pNew^.FileName);
pNew^.Folder := pNewFolder;
pNew^.Size := srSearcher.Size;
pNew^.LastModified := FileDateToDateTime(srSearcher.Time);
pNew^.SearchMatch := False;
pNew^.Next := pKnownFiles;
pNew^.NextMatch := nil;
pKnownFiles := pNew;
inc(iKnownFileCount);
end;
if (iKnownFileCount mod 1000) = 0 then begin
pnlDiscovering.Caption := 'Discovered ' + FormatFloat('###,###,###,##0', iKnownFileCount) + ' Files';
pnlDiscovering.Refresh;
end;
until FindNext(srSearcher) <> 0;
FindClose(srSearcher);
end;
end;
procedure TfrmHereMain.SetLearnButtonAccessability;
var
iRootNodesChecked: Integer;
nRootNode: TTreeNode;
begin
iRootNodesChecked := 0;
nRootNode := TreeView1.Items.GetFirstNode;
while nRootNode <> nil do begin
if nRootNode.Data <> nil then begin
inc(iRootNodesChecked);
break;
end else
nRootNode := nRootNode.getNextSibling;
end;
btnDiscoverFolders.Enabled := (iRootNodesChecked > 0);
btnLearnFilesNow.Enabled := (iRootNodesChecked > 0);
cbxIncludeParent.Enabled := (iRootNodesChecked > 0);
end;
procedure TfrmHereMain.sgMatchesMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Column, Row: Longint;
begin
if Button = mbLeft then begin
sgMatches.MouseToCell(X, Y, Column, Row);
if Row = 0 then
SortResults(Column);
end;
end;
procedure TfrmHereMain.SortResults(aColumn: Integer);
var
pSelected: TFilePtr;
begin
if aColumn = iResultsSortByCol then
bResultSortAscending := not bResultSortAscending;
iResultsSortByCol := aColumn;
lblMatchCount.Caption := 'sorting...';
lblMatchCount.Refresh;
sgMatches.Visible := False;
pSelected := nil;
if sgMatches.Row > 0 then
pSelected := TFilePtr(sgMatches.Objects[0, sgMatches.Row]);
PerformSort(iResultsSortByCol, bResultSortAscending);
DisplaySearchResults;
SelectRowByObject(pSelected);
sgMatches.Visible := True;
edtSelectedMatch.Text := sgMatches.Cells[1, sgMatches.Row]+sgMatches.Cells[0, sgMatches.Row];
lblMatchCount.Caption := FormatFloat('###,###,##0', iMatchCount) + ' matches';
end;
procedure TfrmHereMain.PerformSort(aColumn: Integer; aAscending: Boolean);
var
pElem1, pElem2, pPrefix, pOrigin: TFilePtr;
bChanged, SwitchElems: boolean;
begin
{This proc sorts the entire list of files(not just the search matches),
based on a given grid column.}
if (pKnownFiles = nil) then Exit; {can't sort 0 items!}
if (pKnownFiles^.Next = nil) then Exit; {can't sort just 1 item!}
{Create a temporary new origin for the list. This allows
the first item to be treated the same as items 2..n.}
New(pOrigin);
pOrigin^.NextMatch := pMatches;
bChanged := True;
while bChanged do begin
bChanged := False;
pPrefix := pOrigin;
while (pPrefix <> nil) do begin
pElem1 := pPrefix^.NextMatch;
if pElem1 = nil then break;
pElem2 := pElem1^.NextMatch;
if pElem2 = nil then break;
SwitchElems := False;
if aAscending then begin
case aColumn of
0: SwitchElems := (_StrComp(pElem1^.UCFileName, pElem2^.UCFileName) > 0); {file name}
1: SwitchElems := (_StrComp(pElem1^.Folder^.UCFolder , pElem2^.Folder^.UCFolder) > 0); {folder}
2: SwitchElems := (pElem1^.Size > pElem2^.Size); {Size}
3: SwitchElems := (pElem1^.LastModified > pElem2^.LastModified); {last modified}
end;
end else begin
case aColumn of
0: SwitchElems := (_StrComp(pElem1^.UCFileName, pElem2^.UCFileName) < 0); {file name}
1: SwitchElems := (_StrComp(pElem1^.Folder^.UCFolder , pElem2^.Folder^.UCFolder) < 0); {folder}
2: SwitchElems := (pElem1^.Size < pElem2^.Size); {Size}
3: SwitchElems := (pElem1^.LastModified < pElem2^.LastModified); {last modified}
end;
end;
if SwitchElems then begin
bChanged := True;
pElem1^.NextMatch := pElem2^.NextMatch;
pElem2^.NextMatch := pElem1;
pPrefix^.NextMatch := pElem2;
end;
pPrefix := pPrefix^.NextMatch;
end; {while (pSortPrefix...}
end; {while bChanged...}
pMatches := pOrigin^.NextMatch;
Dispose(pOrigin);
end;
procedure TfrmHereMain.SelectRowByObject(var aSelected: TFilePtr);
var
iRow: Integer;
begin
for iRow := 1 to (sgMatches.RowCount - 1) do
if TFilePtr(sgMatches.Objects[0, iRow]) = aSelected then begin
sgMatches.Row := iRow;
Exit;
end;
end;
function _StrComp(var aStr1, aStr2: string): Integer;
var
iChar, iLen1, iLen2: Integer;
begin
result := 0;
{Get the length of the shorter of the two strings}
iLen1 := Length(aStr1);
iLen2 := Length(aStr2);
if (iLen1 < iLen2) and (iLen1 = 0) then result := -1;
if (iLen2 < iLen1) and (iLen2 = 0) then result := 1;
if result <> 0 then Exit;
if iLen1 > iLen2 then iLen1 := iLen2; {store minimum length in iLen1}
iChar := 1;
while (iChar <= iLen1) and (result = 0) do begin
Result := (Ord(aStr1[iChar]) - Ord(aStr2[iChar]));
inc(iChar);
end;
if result = 0 then
if Length(aStr1) > Length(aStr2) then
result := 1
else
if Length(aStr1) < Length(aStr2) then
result := -1;
end;
end.
]]>