home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / SRC / FILEFIND.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-02-15  |  14.7 KB  |  529 lines
  1. {**************************************************************************}
  2. {                                                                          }
  3. {    Calmira shell for Microsoft« Windows(TM) 3.1                          }
  4. {    Source Release 1.0                                                    }
  5. {    Copyright (C) 1997  Li-Hsin Huang                                     }
  6. {                                                                          }
  7. {    This program is free software; you can redistribute it and/or modify  }
  8. {    it under the terms of the GNU General Public License as published by  }
  9. {    the Free Software Foundation; either version 2 of the License, or     }
  10. {    (at your option) any later version.                                   }
  11. {                                                                          }
  12. {    This program is distributed in the hope that it will be useful,       }
  13. {    but WITHOUT ANY WARRANTY; without even the implied warranty of        }
  14. {    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         }
  15. {    GNU General Public License for more details.                          }
  16. {                                                                          }
  17. {    You should have received a copy of the GNU General Public License     }
  18. {    along with this program; if not, write to the Free Software           }
  19. {    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.             }
  20. {                                                                          }
  21. {**************************************************************************}
  22.  
  23. unit FileFind;
  24.  
  25. { Find dialog
  26.  
  27.   Performs a recursive background search for the specified files,
  28.   and adds the file details to a multi-column list box.  The fields
  29.   are encoded and unformatted in the DrawItem handler.  This limits
  30.   the number of entries, so for a greater capacity, consider moving
  31.   the data into a TStringList and just adding null fields in the
  32.   listbox (the string list probably uses more memory because it
  33.   allocates lots of small blocks).
  34.  
  35.   The listbox is a drag-drop source, and has a separate global
  36.   variable pointing to it.  This is so that drag-drop targets can
  37.   check the source without dereferencing the FindForm variable,
  38.   whieh may be nil when the dialog is not open.
  39. }
  40.  
  41. interface
  42.  
  43. uses WinTypes, WinProcs, Classes, Forms, Controls, Buttons, CalForm,
  44.   StdCtrls, ExtCtrls, SysUtils, Menus, DragDrop, DropServ, Graphics,
  45.   TabNotBk, Settings;
  46.  
  47. type
  48.   TFindForm = class(TCalForm)
  49.     CloseBtn: TBitBtn;
  50.     SearchBtn: TBitBtn;
  51.     ClearBtn: TBitBtn;
  52.     Header: THeader;
  53.     Menu: TPopupMenu;
  54.     OpenParent: TMenuItem;
  55.     Delete: TMenuItem;
  56.     DropServer: TDropServer;
  57.     OpenFile: TMenuItem;
  58.     N1: TMenuItem;
  59.     Listbox: TListBox;
  60.     Bevel1: TBevel;
  61.     Bevel2: TBevel;
  62.     FoundLabel: TLabel;
  63.     SelLabel: TLabel;
  64.     Notebook: TTabbedNotebook;
  65.     Label1: TLabel;
  66.     FileEdit: TComboBox;
  67.     Label2: TLabel;
  68.     StartEdit: TComboBox;
  69.     WholeDrive: TRadioButton;
  70.     SubFolders: TRadioButton;
  71.     OneFolder: TRadioButton;
  72.     procedure SearchBtnClick(Sender: TObject);
  73.     procedure FormCreate(Sender: TObject);
  74.     procedure CloseBtnClick(Sender: TObject);
  75.     procedure ClearBtnClick(Sender: TObject);
  76.     procedure ListboxDrawItem(Control: TWinControl; Index: Integer;
  77.       Rect: TRect; State: TOwnerDrawState);
  78.     procedure HeaderSized(Sender: TObject; ASection, AWidth: Integer);
  79.     procedure FormDestroy(Sender: TObject);
  80.     procedure DeleteClick(Sender: TObject);
  81.     procedure OpenParentClick(Sender: TObject);
  82.     procedure MenuPopup(Sender: TObject);
  83.     procedure FormShow(Sender: TObject);
  84.     procedure DropServerFileDrop(Sender: TObject; X, Y: Integer;
  85.       Target: Word);
  86.     procedure ListboxMouseMove(Sender: TObject; Shift: TShiftState; X,
  87.       Y: Integer);
  88.     procedure ListboxEndDrag(Sender, Target: TObject; X, Y: Integer);
  89.     procedure OpenFileClick(Sender: TObject);
  90.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  91.     procedure StartEditKeyPress(Sender: TObject; var Key: Char);
  92.     procedure WholeDriveClick(Sender: TObject);
  93.     procedure ListboxClick(Sender: TObject);
  94.     procedure FormPaint(Sender: TObject);
  95.     procedure StartEditDblClick(Sender: TObject);
  96.     procedure StartEditChange(Sender: TObject);
  97.   private
  98.     { Private declarations }
  99.     Searching: Boolean;
  100.     FSelection: TStringList;
  101.     LocStart, SizeStart, DateStart: Integer;
  102.     Changed : Boolean;
  103.     FileSpecs : TStringList;
  104.     procedure SearchFiles(const StartPath: TFilename);
  105.     procedure ExtractSearchMasks;
  106.     procedure UpdateStatusBar;
  107.   public
  108.     { Public declarations }
  109.     function CompileSelection: TStringList;
  110.     procedure SettingsChanged(Changes : TSettingChanges); override;
  111.     function FileAt(i: Integer) : TFilename;
  112.     property Selection : TStringList read FSelection;
  113.   end;
  114.  
  115.   EFindError = class(Exception);
  116.  
  117. var
  118.   FindForm: TFindForm;
  119.   FindList: TListBox;
  120.  
  121. procedure FileFindExecute(const StartPath : string; RadioIndex: Integer);
  122.  
  123. implementation
  124.  
  125. {$R *.DFM}
  126.  
  127. uses Dialogs, Resource, Strings, MiscUtil, Tree,
  128.   Fileman, Drives, Desk, FileCtrl, Files, Directry;
  129.  
  130.  
  131. procedure TFindForm.ExtractSearchMasks;
  132. var
  133.   specs : TFilename;
  134.   i : Integer;
  135. begin
  136.   specs := Trim(FileEdit.Text);
  137.   if specs = '' then raise
  138.     EFindError.Create('Please specify the files to search for.');
  139.  
  140.   { separate the file sepcifications and add to a string list }
  141.  
  142.   FileSpecs.Clear;
  143.   i := Pos(';', specs);
  144.   while i > 0 do begin
  145.     FileSpecs.Add(Copy(specs, 1, i-1));
  146.     System.Delete(specs, 1, i);
  147.     i := Pos(';', specs);
  148.   end;
  149.   if specs > '' then FileSpecs.Add(specs);
  150. end;
  151.  
  152.  
  153. procedure TFindForm.UpdateStatusBar;
  154. begin
  155.   FoundLabel.Caption := Format('%d items found', [Listbox.Items.Count]);
  156.   SelLabel.Caption := Format('%d selected', [Listbox.SelCount]);
  157. end;
  158.  
  159.  
  160. procedure TFindForm.SearchBtnClick(Sender: TObject);
  161. begin
  162.   if Searching then begin
  163.     Searching := False;
  164.     exit;
  165.   end;
  166.  
  167.   Changed := AddHistory(FileEdit) or Changed;
  168.   Changed := AddHistory(StartEdit) or Changed;
  169.  
  170.   Searching := True;
  171.   SearchBtn.Caption := 'Stop';
  172.   Notebook.Enabled := False;
  173.   CloseBtn.Enabled := False;
  174.   ClearBtn.Enabled := False;
  175.   Listbox.Enabled := True;
  176.   Cursor := crBusyPointer;
  177.  
  178.   try
  179.     with StartEdit do begin
  180.       Text := Lowercase(ExpandFilename(Text));
  181.       if WholeDrive.Checked then Text := Copy(Text, 1, 3);
  182.       ExtractSearchMasks;
  183.       SearchFiles(MakePath(Text));
  184.     end;
  185.   finally
  186.     Searching := False;
  187.     SearchBtn.Caption := 'Search';
  188.     Notebook.Enabled := True;
  189.     CloseBtn.Enabled := True;
  190.     ClearBtn.Enabled := True;
  191.     Screen.Cursor := crDefault;
  192.     Listbox.Items.EndUpdate;
  193.     Cursor := crDefault;
  194.  
  195.     PlaySound(Sounds.Values['NotifyCompletion']);
  196.     if Listbox.Items.Count = 0 then begin
  197.       MsgDialog('No matching files found', mtInformation, [mbOK], 0);
  198.       Listbox.Enabled := False;
  199.     end
  200.     else Listbox.Enabled := True;
  201.     UpdateStatusBar;
  202.   end;
  203. end;
  204.  
  205.  
  206.  
  207.  
  208. procedure TFindForm.SearchFiles(const StartPath: TFilename);
  209. var
  210.   rec: TSearchRec;
  211.   code, i : Integer;
  212.   icon : TIcon;
  213. begin
  214.   Application.ProcessMessages;
  215.   if not Searching or Application.Terminated then Abort;
  216.  
  217.   for i := 0 to FileSpecs.Count-1 do begin
  218.  
  219.   { loop through wildcards }
  220.   code := FindFirst(StartPath + FileSpecs[i], faAnyFile and not faVolumeID, rec);
  221.  
  222.   while code = 0 do begin
  223.     if rec.name[1] <> '.' then begin
  224.  
  225.       rec.name := Lowercase(rec.name);
  226.  
  227.       if rec.attr and faDirectory > 0 then
  228.         icon := TinyFolder
  229.       else if ExtensionIn(Copy(ExtractFileExt(rec.name), 2, 3), programs) then
  230.         icon := TinyProg
  231.       else
  232.         icon := TinyFile;
  233.  
  234.       Listbox.Items.AddObject(Format('%s;%s;%s;%s',
  235.         [rec.name, MakeDirname(StartPath), FormatByte(rec.size),
  236.          DateToStr(TimestampToDate(rec.time))]), icon);
  237.     end;
  238.     Application.ProcessMessages;
  239.     code := FindNext(rec);
  240.   end;
  241.  
  242.   end;
  243.  
  244.   if not OneFolder.Checked then begin
  245.     { search subdirs }
  246.     code := FindFirst(StartPath + '*.*', faDirectory, rec);
  247.     while code = 0 do begin
  248.       if (rec.Attr and faDirectory <> 0) and (rec.name[1] <> '.') then
  249.         SearchFiles(StartPath + Lowercase(rec.name) + '\');
  250.       Application.ProcessMessages;
  251.       code := FindNext(rec);
  252.     end;
  253.   end;
  254. end;
  255.  
  256.  
  257.  
  258. procedure TFindForm.FormCreate(Sender: TObject);
  259. begin
  260.   Icon.Assign(Icons.Get('FindDialog'));
  261.   CloseBtn.Cancel := True;
  262.   Notebook.PageIndex := 0;
  263.   Searching := False;
  264.   Listbox.DragCursor := crDropFile;
  265.   FSelection := TStringList.Create;
  266.   FileSpecs := TStringList.Create;
  267.   FileSpecs.Duplicates := dupIgnore;
  268.   FindList := Listbox;
  269.   Listbox.ItemHeight := LineHeight;
  270.   ini.ReadStrings('Search for', FileEdit.Items);
  271.   ini.ReadStrings('Start from', StartEdit.Items);
  272.   ini.ReadHeader('Find files', Header);
  273.   HeaderSized(Header, 0, Header.SectionWidth[0]);
  274. end;
  275.  
  276.  
  277. procedure TFindForm.CloseBtnClick(Sender: TObject);
  278. begin
  279.   Close;
  280. end;
  281.  
  282.  
  283. procedure TFindForm.ClearBtnClick(Sender: TObject);
  284. begin
  285.   with Listbox do begin
  286.     Items.Clear;
  287.     FoundLabel.Caption := '0 items found';
  288.     SelLabel.Caption := '0 selected';
  289.     Enabled := False;
  290.   end;
  291. end;
  292.  
  293. procedure TFindForm.ListboxDrawItem(Control: TWinControl; Index: Integer;
  294.   Rect: TRect; State: TOwnerDrawState);
  295. var
  296.   filename: string[15];
  297.   location: TFilename;
  298.   size    : string[15];
  299.   date    : string[15];
  300. begin
  301.   with Listbox, Listbox.Canvas do begin
  302.     FillRect(Rect);
  303.  
  304.     if FindDlgIcons then begin
  305.       Draw(Rect.Left, Rect.Top, TIcon(Items.Objects[Index]));
  306.       Inc(Rect.Left, 20);
  307.     end;
  308.  
  309.     Inc(Rect.Top);
  310.     Unformat(Items[Index], '%s;%s;%s;%s',
  311.       [@filename, 15, @location, 79, @size, 15, @date, 15]);
  312.  
  313.     TextOut(Rect.Left + 2, Rect.Top, filename);
  314.     TextOut(LocStart, Rect.Top, MinimizeName(location, Canvas, SizeStart - LocStart));
  315.     TextOut(DateStart-10-TextWidth(size), Rect.Top, size);
  316.     TextOut(DateStart, Rect.Top, date);
  317.   end;
  318. end;
  319.  
  320.  
  321. procedure TFindForm.HeaderSized(Sender: TObject; ASection,
  322.   AWidth: Integer);
  323. begin
  324.   with Header do begin
  325.     LocStart := SectionWidth[0];
  326.     SizeStart := LocStart + SectionWidth[1];
  327.     DateStart := SizeStart + SectionWidth[2];
  328.   end;
  329.   Listbox.Invalidate;
  330. end;
  331.  
  332.  
  333. function TFindForm.FileAt(i: Integer): TFilename;
  334. var
  335.   name: string[15];
  336.   location : TFilename;
  337. begin
  338.   { The listbox stores the name and location the wrong way around...}
  339.   Unformat(Listbox.Items[i], '%s;%s;', [@name, 15, @location, 79]);
  340.   Result := MakePath(location) + name;
  341. end;
  342.  
  343.  
  344. function TFindForm.CompileSelection: TStringList;
  345. var
  346.   i: Integer;
  347. begin
  348.   FSelection.Clear;
  349.   for i := 0 to Listbox.Items.Count-1 do
  350.     if Listbox.Selected[i] then FSelection.Add(FileAt(i));
  351.   Result := FSelection;
  352. end;
  353.  
  354.  
  355. procedure TFindForm.FormDestroy(Sender: TObject);
  356. begin
  357.   ini.WriteHeader('Find files', Header);
  358.  
  359.   if Changed then with ini do begin
  360.     EraseSection('Search for');
  361.     WriteStrings('Search for', FileEdit.Items);
  362.  
  363.     EraseSection('Start from');
  364.     WriteStrings('Start from', StartEdit.Items);
  365.   end;
  366.  
  367.   FSelection.Free;
  368.   FileSpecs.Free;
  369.   FindList := nil;
  370.   FindForm := nil;
  371. end;
  372.  
  373.  
  374.  
  375. procedure TFindForm.DeleteClick(Sender: TObject);
  376. var
  377.   i: Integer;
  378.   s: TFilename;
  379. begin
  380.   if not Searching then with Listbox do begin
  381.     NoToAll;
  382.     i := 0;
  383.     Items.BeginUpdate;
  384.     Screen.Cursor := crHourGlass;
  385.     try
  386.       for i := Items.Count-1 downto 0 do
  387.         if Selected[i] then begin
  388.           if KeyBreak and (GetAsyncKeyState(VK_ESCAPE) < 0) then Break;
  389.           s := FileAt(i);
  390.           if (Items.Objects[i] = TinyFile) and EraseFile(s, -1) then begin
  391.             Items.Delete(i);
  392.             Desktop.RefreshList.Add(ExtractFileDir(s));
  393.           end
  394.         end;
  395.     finally
  396.       Desktop.RefreshNow;
  397.       Screen.Cursor := crDefault;
  398.       Items.EndUpdate;
  399.       Enabled := Items.Count > 0;
  400.       UpdateStatusBar;
  401.     end;
  402.   end;
  403. end;
  404.  
  405.  
  406. procedure TFindForm.OpenParentClick(Sender: TObject);
  407. begin
  408.   with Listbox do
  409.   if ItemIndex <> -1 then
  410.     Desktop.OpenFolder(ExtractFileDir(FileAt(ItemIndex)));
  411. end;
  412.  
  413.  
  414. procedure TFindForm.MenuPopup(Sender: TObject);
  415. begin
  416.   OpenFile.Enabled := Listbox.ItemIndex <> -1;
  417.   OpenParent.Enabled := OpenFile.Enabled;
  418.   Delete.Enabled := OpenFile.Enabled;
  419. end;
  420.  
  421.  
  422. procedure TFindForm.FormShow(Sender: TObject);
  423. var s: string;
  424. begin
  425.   if StartEdit.Text = '' then begin
  426.     GetDir(0, s);
  427.     StartEdit.Text := Copy(s, 1, 3);
  428.   end;
  429. end;
  430.  
  431.  
  432. procedure TFindForm.DropServerFileDrop(Sender: TObject; X, Y: Integer;
  433.   Target: Word);
  434. begin
  435.   DropServer.Files.Assign(CompileSelection);
  436. end;
  437.  
  438.  
  439. procedure TFindForm.ListboxMouseMove(Sender: TObject; Shift: TShiftState;
  440.   X, Y: Integer);
  441. begin
  442.   if Listbox.Dragging and DropServer.CanDrop and AnimCursor then
  443.     SetCursor(Screen.Cursors[crFlutter])
  444. end;
  445.  
  446.  
  447. procedure TFindForm.ListboxEndDrag(Sender, Target: TObject; X,
  448.   Y: Integer);
  449. begin
  450.   DropServer.DragFinished;
  451. end;
  452.  
  453.  
  454. procedure TFindForm.OpenFileClick(Sender: TObject);
  455. var
  456.   s: TFilename;
  457. begin
  458.   with Listbox do
  459.   if ItemIndex <> -1 then begin
  460.     s := FileAt(ItemIndex);
  461.     if Items.Objects[ItemIndex] = TinyFolder then Desktop.OpenFolder(s)
  462.     else DefaultExec(s, '', ExtractFileDir(s), SW_SHOWNORMAL);
  463.   end;
  464. end;
  465.  
  466.  
  467. procedure TFindForm.FormClose(Sender: TObject; var Action: TCloseAction);
  468. begin
  469.   Action := caFree
  470. end;
  471.  
  472.  
  473. procedure FileFindExecute(const StartPath : string; RadioIndex: Integer);
  474. begin
  475.   if FindForm = nil then FindForm := TFindForm.Create(Application);
  476.  
  477.   with FindForm do begin
  478.     StartEdit.Text := Lowercase(StartPath);
  479.     SetRadioIndex([WholeDrive, SubFolders, OneFolder], RadioIndex);
  480.     WindowState := wsNormal;
  481.     Show;
  482.   end;
  483. end;
  484.  
  485.  
  486. procedure TFindForm.StartEditKeyPress(Sender: TObject; var Key: Char);
  487. begin
  488.   Key := LowCase(Key);
  489. end;
  490.  
  491.  
  492. procedure TFindForm.WholeDriveClick(Sender: TObject);
  493. begin
  494.   StartEdit.Text := Copy(StartEdit.Text, 1, 3);
  495. end;
  496.  
  497.  
  498. procedure TFindForm.ListboxClick(Sender: TObject);
  499. begin
  500.   UpdateStatusBar;
  501. end;
  502.  
  503.  
  504. procedure TFindForm.FormPaint(Sender: TObject);
  505. begin
  506.   Border3D(Canvas, ClientWidth-1, ClientHeight-1);
  507. end;
  508.  
  509.  
  510. procedure TFindForm.StartEditDblClick(Sender: TObject);
  511. begin
  512.   SubFolders.Checked := True;
  513.   StartEdit.Text := SelectFolder(StartEdit.Text);
  514. end;
  515.  
  516.  
  517. procedure TFindForm.StartEditChange(Sender: TObject);
  518. begin
  519.   if WholeDrive.Checked then SubFolders.Checked := True;
  520. end;
  521.  
  522.  
  523. procedure TFindForm.SettingsChanged(Changes : TSettingChanges);
  524. begin
  525.   if scFileSystem in Changes then Listbox.Invalidate;
  526. end;
  527.  
  528. end.
  529.