home *** CD-ROM | disk | FTP | other *** search
/ PC Open 19 / pcopen19.iso / Zipped / CALMIR21.ZIP / SOURCE.ZIP / SRC / FILEFIND.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-20  |  17.3 KB  |  617 lines
  1. {**************************************************************************}
  2. {                                                                          }
  3. {    Calmira shell for Microsoft« Windows(TM) 3.1                          }
  4. {    Source Release 2.1                                                    }
  5. {    Copyright (C) 1997-1998 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.     CancelBtn: TBitBtn;
  50.     SearchBtn: TBitBtn;
  51.     Header: THeader;
  52.     Menu: TPopupMenu;
  53.     OpenParent: TMenuItem;
  54.     Delete: TMenuItem;
  55.     DropServer: TDropServer;
  56.     Open: TMenuItem;
  57.     N1: TMenuItem;
  58.     Listbox: TListBox;
  59.     FoundLabel: TLabel;
  60.     SelLabel: TLabel;
  61.     Notebook: TTabbedNotebook;
  62.     Label1: TLabel;
  63.     FileEdit: TComboBox;
  64.     Label2: TLabel;
  65.     StartEdit: TComboBox;
  66.     N2: TMenuItem;
  67.     CopyFilenames: TMenuItem;
  68.     CopyFileInfo: TMenuItem;
  69.     Bevel3: TBevel;
  70.     Image: TImage;
  71.     SubFolders: TCheckBox;
  72.     OpenWith: TMenuItem;
  73.     ClearList: TCheckBox;
  74.     procedure SearchBtnClick(Sender: TObject);
  75.     procedure FormCreate(Sender: TObject);
  76.     procedure CancelBtnClick(Sender: TObject);
  77.     procedure ListboxDrawItem(Control: TWinControl; Index: Integer;
  78.       Rect: TRect; State: TOwnerDrawState);
  79.     procedure HeaderSized(Sender: TObject; ASection, AWidth: Integer);
  80.     procedure FormDestroy(Sender: TObject);
  81.     procedure DeleteClick(Sender: TObject);
  82.     procedure OpenParentClick(Sender: TObject);
  83.     procedure MenuPopup(Sender: TObject);
  84.     procedure FormShow(Sender: TObject);
  85.     procedure DropServerFileDrop(Sender: TObject; X, Y: Integer;
  86.       Target: Word);
  87.     procedure ListboxMouseMove(Sender: TObject; Shift: TShiftState; X,
  88.       Y: Integer);
  89.     procedure ListboxEndDrag(Sender, Target: TObject; X, Y: Integer);
  90.     procedure OpenClick(Sender: TObject);
  91.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  92.     procedure StartEditKeyPress(Sender: TObject; var Key: Char);
  93.     procedure ListboxClick(Sender: TObject);
  94.     procedure FormPaint(Sender: TObject);
  95.     procedure StartEditDblClick(Sender: TObject);
  96.     procedure CopyFilenamesClick(Sender: TObject);
  97.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  98.     procedure FormResize(Sender: TObject);
  99.     procedure OpenWithClick(Sender: TObject);
  100.   private
  101.     { Private declarations }
  102.     Searching: Boolean;
  103.     FSelection: TStringList;
  104.     LocStart, SizeStart, DateStart: Integer;
  105.     Changed : Boolean;
  106.     FileSpecs : TStringList;
  107.     SearchCount : Integer;
  108.     procedure SearchFiles(const StartPath: TFilename);
  109.     procedure ExtractSearchMasks;
  110.     procedure UpdateStatusBar;
  111.   public
  112.     { Public declarations }
  113.     function CompileSelection: TStringList;
  114.     procedure SettingsChanged(Changes : TSettingChanges); override;
  115.     function FilenameAt(i: Integer) : TFilename;
  116.     function IsFile(i: Integer): Boolean;
  117.     property Selection : TStringList read FSelection;
  118.   end;
  119.  
  120.   EFindError = class(Exception);
  121.  
  122. var
  123.   FindForm: TFindForm;
  124.   FindList: TListBox;
  125.  
  126. procedure FileFindExecute(const StartPath : string);
  127.  
  128. implementation
  129.  
  130. {$R *.DFM}
  131.  
  132. uses Dialogs, Resource, Strings, MiscUtil, Tree, IconWin, OpenFile,
  133.   Fileman, Drives, Desk, FileCtrl, Files, Directry, Locale, Embed;
  134.  
  135.  
  136. procedure TFindForm.ExtractSearchMasks;
  137. var specs : TFilename;
  138. begin
  139.   specs := RemoveSpaces(FileEdit.Text);
  140.   FileSpecs.Clear;
  141.   if specs > '' then
  142.     repeat FileSpecs.Add(GetWord(specs, ';')) until specs = '';
  143. end;
  144.  
  145.  
  146. procedure TFindForm.UpdateStatusBar;
  147. begin
  148.   FoundLabel.Caption := Format(SSItemsFound, [Listbox.Items.Count]);
  149.   SelLabel.Caption := Format(SSFoundSelected, [Listbox.SelCount]);
  150. end;
  151.  
  152.  
  153. procedure TFindForm.SearchBtnClick(Sender: TObject);
  154. begin
  155.   if Searching then begin
  156.     Searching := False;
  157.     Exit;
  158.   end;
  159.  
  160.   if ClearList.Checked then with Listbox do begin
  161.     Items.Clear;
  162.     UpdateStatusBar;
  163.     Enabled := False;
  164.     SearchCount := 0;
  165.   end;
  166.  
  167.   with StartEdit do begin
  168.     case Length(Text) of
  169.       0   : Text := 'c:\';
  170.       1..2: if Text[1] in Alphas then Text := Text[1] + ':\';
  171.       else Text := MakePath(Lowercase(Text));
  172.     end;
  173.   end;
  174.   ExtractSearchMasks;
  175.   if FileSpecs.Count = 0 then raise EFindError.CreateRes(SSpecifyFiles);
  176.  
  177.   Changed := AddHistory(FileEdit) or Changed;
  178.   Changed := AddHistory(StartEdit) or Changed;
  179.  
  180.   Searching := True;
  181.   Inc(SearchCount);
  182.  
  183.   SearchBtn.Caption := LoadStr(SStopSearch);
  184.   CancelBtn.Enabled := False;
  185.   Listbox.Enabled := True;
  186.   Desktop.SetCursor(crBusyPointer);
  187.  
  188.   try
  189.     SearchFiles(StartEdit.Text);
  190.   finally
  191.     Searching := False;
  192.     SearchBtn.Caption := LoadStr(SStartSearch);
  193.     CancelBtn.Enabled := True;
  194.     Listbox.Items.EndUpdate;
  195.     Desktop.ReleaseCursor;
  196.  
  197.     PlaySound(Sounds.Values['NotifyCompletion']);
  198.     if Listbox.Items.Count = 0 then begin
  199.       if Application.Active then
  200.         MsgDialogRes(SNoMatchingFiles, mtInformation, [mbOK], 0);
  201.       Listbox.Enabled := False;
  202.     end
  203.     else Listbox.Enabled := True;
  204.     UpdateStatusBar;
  205.   end;
  206. end;
  207.  
  208.  
  209.  
  210. { buffers which are kept off the stack }
  211.  
  212. var
  213.   ListEntry : string;
  214.   SizeStr : string[15];
  215.  
  216. procedure TFindForm.SearchFiles(const StartPath: TFilename);
  217. var
  218.   rec: TSearchRec;
  219.   code, i : Integer;
  220.   icon : TIcon;
  221. begin
  222.   Application.ProcessMessages;
  223.   if not Searching or Application.Terminated then Abort;
  224.  
  225.   for i := 0 to FileSpecs.Count-1 do begin
  226.  
  227.   { loop through wildcards }
  228.   code := FindFirst(StartPath + FileSpecs[i], faAnyFile and not faVolumeID, rec);
  229.  
  230.   while code = 0 do begin
  231.     if rec.name[1] <> '.' then begin
  232.  
  233.       rec.name := Lowercase(rec.name);
  234.  
  235.       if rec.attr and faDirectory > 0 then
  236.         icon := TinyFolder
  237.       else if ExtensionIn(Copy(ExtractFileExt(rec.name), 2, 3), programs) then
  238.         icon := TinyProg
  239.       else
  240.         icon := TinyFile;
  241.  
  242.  
  243.       if rec.attr and faDirectory > 0 then SizeStr := '<DIR>'
  244.       else SizeStr := FormatByte(rec.size, ListKBDecimals);
  245.  
  246.       ListEntry := Format('%s;%s;%s;%s', [rec.name, MakeDirname(StartPath),
  247.         sizestr, DateToStr(TimestampToDate(rec.time))]);
  248.  
  249.       try
  250.         with Listbox.Items do
  251.           if ((FileSpecs.Count = 1) and (SearchCount = 1)) or
  252.             (IndexOf(ListEntry) = -1) then begin
  253.               AddObject(ListEntry, icon);
  254.             if Count mod 20 = 0 then UpdateStatusbar;
  255.           end;
  256.       except
  257.         on EOutOfResources do begin
  258.           MsgDialogRes(SFindListboxFull, mtInformation, [mbOK], 0);
  259.           Abort;
  260.         end;
  261.       end;
  262.     end;
  263.     Application.ProcessMessages;
  264.     code := FindNext(rec);
  265.   end;
  266.  
  267.   end;
  268.  
  269.   if SubFolders.Checked then begin
  270.     { search subdirs }
  271.     code := FindFirst(StartPath + '*.*', faDirectory, rec);
  272.     while code = 0 do begin
  273.       if (rec.Attr and faDirectory <> 0) and (rec.name[1] <> '.') then
  274.         SearchFiles(StartPath + Lowercase(rec.name) + '\');
  275.       Application.ProcessMessages;
  276.       code := FindNext(rec);
  277.     end;
  278.   end;
  279. end;
  280.  
  281.  
  282.  
  283. procedure TFindForm.FormCreate(Sender: TObject);
  284. begin
  285.   Icon.Assign(Icons.Get('FindDialog'));
  286.   Image.Picture.Icon.Assign(Icon);
  287.   Searching := False;
  288.   Listbox.DragCursor := crDropFile;
  289.   FSelection := TStringList.Create;
  290.   FileSpecs := TStringList.Create;
  291.   FileSpecs.Duplicates := dupIgnore;
  292.   FindList := Listbox;
  293.   Listbox.ItemHeight := LineHeight;
  294.   LoadPosition(ini, 'Find Dialog');
  295.   ini.ReadStrings('Search for', FileEdit.Items);
  296.   ini.ReadStrings('Start from', StartEdit.Items);
  297.   ini.ReadHeader('Find Dialog', Header);
  298.   HeaderSized(Header, 0, Header.SectionWidth[0]);
  299. end;
  300.  
  301.  
  302. procedure TFindForm.CancelBtnClick(Sender: TObject);
  303. begin
  304.   Close;
  305. end;
  306.  
  307.  
  308. procedure TFindForm.ListboxDrawItem(Control: TWinControl; Index: Integer;
  309.   Rect: TRect; State: TOwnerDrawState);
  310. var
  311.   filename: string[15];
  312.   location: TFilename;
  313.   size    : string[15];
  314.   date    : string[15];
  315. begin
  316.   with Listbox, Listbox.Canvas do begin
  317.     FillRect(Rect);
  318.  
  319.     if FindDlgIcons then begin
  320.       Draw(Rect.Left, Rect.Top, TIcon(Items.Objects[Index]));
  321.       Inc(Rect.Left, 20);
  322.     end;
  323.  
  324.     Inc(Rect.Top);
  325.     Unformat(Items[Index], '%s;%s;%s;%s',
  326.       [@filename, 15, @location, 79, @size, 15, @date, 15]);
  327.  
  328.     TextOut(Rect.Left + 2, Rect.Top, filename);
  329.     TextOut(LocStart, Rect.Top, MinimizeName(location, Canvas, SizeStart - LocStart));
  330.     TextOut(DateStart-10-TextWidth(size), Rect.Top, size);
  331.     TextOut(DateStart, Rect.Top, date);
  332.   end;
  333. end;
  334.  
  335.  
  336. procedure TFindForm.HeaderSized(Sender: TObject; ASection,
  337.   AWidth: Integer);
  338. begin
  339.   GetHeaderDivisions(Header, [@LocStart, @SizeStart, @DateStart]);
  340.   Listbox.Invalidate;
  341. end;
  342.  
  343.  
  344. function TFindForm.FilenameAt(i: Integer): TFilename;
  345. var
  346.   name: string[15];
  347.   location : TFilename;
  348. begin
  349.   { The listbox stores the name and location the wrong way around...}
  350.   Unformat(Listbox.Items[i], '%s;%s;', [@name, 15, @location, 79]);
  351.   Result := MakePath(location) + name;
  352. end;
  353.  
  354. function TFindForm.IsFile(i: Integer): Boolean;
  355. begin
  356.   Result := Listbox.Items.Objects[i] <> TinyFolder;
  357. end;
  358.  
  359.  
  360. function TFindForm.CompileSelection: TStringList;
  361. var
  362.   i: Integer;
  363. begin
  364.   FSelection.Clear;
  365.   for i := 0 to Listbox.Items.Count-1 do
  366.     if Listbox.Selected[i] then FSelection.Add(FilenameAt(i));
  367.   Result := FSelection;
  368. end;
  369.  
  370.  
  371. procedure TFindForm.FormDestroy(Sender: TObject);
  372. begin
  373.   ini.WriteHeader('Find Dialog', Header);
  374.  
  375.   if Changed then begin
  376.     ini.RewriteSectionStrings('Search for', FileEdit.Items);
  377.     ini.RewriteSectionStrings('Start from', StartEdit.Items);
  378.   end;
  379.  
  380.   FSelection.Free;
  381.   FileSpecs.Free;
  382.   FindList := nil;
  383.   FindForm := nil;
  384. end;
  385.  
  386.  
  387.  
  388. procedure TFindForm.DeleteClick(Sender: TObject);
  389. var
  390.   i: Integer;
  391.   s: TFilename;
  392. begin
  393.   if not Searching then with Listbox do begin
  394.     NoToAll;
  395.     i := 0;
  396.     Items.BeginUpdate;
  397.     Desktop.SetCursor(crHourGlass);
  398.     try
  399.       for i := Items.Count-1 downto 0 do
  400.         if Selected[i] then begin
  401.           if GetAsyncKeyState(VK_ESCAPE) < 0 then Break;
  402.           s := FilenameAt(i);
  403.           if IsFile(i) and EraseFile(s, -1) then begin
  404.             Items.Delete(i);
  405.             Desktop.RefreshList.Add(ExtractFileDir(s));
  406.           end
  407.         end;
  408.     finally
  409.       Desktop.RefreshNow;
  410.       Desktop.ReleaseCursor;
  411.       Items.EndUpdate;
  412.       Enabled := Items.Count > 0;
  413.       UpdateStatusBar;
  414.     end;
  415.   end;
  416. end;
  417.  
  418.  
  419. procedure TFindForm.OpenParentClick(Sender: TObject);
  420. var
  421.   folder, filename: TFilename;
  422.   w: TIconWindow;
  423. begin
  424.   with Listbox do
  425.   if ItemIndex <> -1 then begin
  426.     filename := FilenameAt(ItemIndex);
  427.     folder := ExtractFileDir(filename);
  428.     Desktop.OpenFolder(folder);
  429.     w := Desktop.WindowOf(folder);
  430.     if w <> nil then w.GotoItem(ExtractFilename(filename));
  431.   end;
  432. end;
  433.  
  434.  
  435. procedure TFindForm.MenuPopup(Sender: TObject);
  436. begin
  437.   Open.Enabled := Listbox.ItemIndex <> -1;
  438.   OpenWith.Enabled := Open.Enabled and IsFile(Listbox.ItemIndex);
  439.   OpenParent.Enabled := Open.Enabled;
  440.   Delete.Enabled := Open.Enabled;
  441. end;
  442.  
  443.  
  444. procedure TFindForm.FormShow(Sender: TObject);
  445. begin
  446.   if StartEdit.Text = '' then
  447.     StartEdit.Text := Copy(CurrentDirectory, 1, 3);
  448.   ActiveControl := FileEdit;
  449. end;
  450.  
  451.  
  452. procedure TFindForm.DropServerFileDrop(Sender: TObject; X, Y: Integer;
  453.   Target: Word);
  454. begin
  455.   with DropServer.Files do begin
  456.     Assign(CompileSelection);
  457.     if IsPrintManager(Target) and (Count > 0) then begin
  458.       PrintFile(Strings[0]);
  459.       Clear;
  460.     end;
  461.   end;
  462. end;
  463.  
  464.  
  465. procedure TFindForm.ListboxMouseMove(Sender: TObject; Shift: TShiftState;
  466.   X, Y: Integer);
  467. begin
  468.   if Listbox.Dragging and DropServer.CanDrop and AnimCursor then
  469.     SetCursor(Screen.Cursors[crFlutter])
  470. end;
  471.  
  472.  
  473. procedure TFindForm.ListboxEndDrag(Sender, Target: TObject; X,
  474.   Y: Integer);
  475. begin
  476.   DropServer.DragFinished;
  477. end;
  478.  
  479.  
  480. procedure TFindForm.OpenClick(Sender: TObject);
  481. var
  482.   s: TFilename;
  483. begin
  484.   with Listbox do
  485.   if ItemIndex <> -1 then begin
  486.     s := FilenameAt(ItemIndex);
  487.     if Items.Objects[ItemIndex] = TinyFolder then Desktop.OpenFolder(s)
  488.     else DefaultExec(s, '', ExtractFileDir(s), SW_SHOW);
  489.   end;
  490. end;
  491.  
  492.  
  493. procedure TFindForm.FormClose(Sender: TObject; var Action: TCloseAction);
  494. begin
  495.   Action := caFree;
  496.   SavePosition(ini, 'Find Dialog');
  497. end;
  498.  
  499.  
  500. procedure FileFindExecute(const StartPath : string);
  501. begin
  502.   ShowHourglass;
  503.   if FindForm = nil then FindForm := TFindForm.Create(Application);
  504.  
  505.   with FindForm do begin
  506.     if Searching then Searching := False;
  507.     AssignHistoryText(FileEdit, '');
  508.     AssignHistoryText(StartEdit, Lowercase(StartPath));
  509.     WindowState := wsNormal;
  510.     Show;
  511.   end;
  512. end;
  513.  
  514.  
  515. procedure TFindForm.StartEditKeyPress(Sender: TObject; var Key: Char);
  516. begin
  517.   Key := LowCase(Key);
  518. end;
  519.  
  520.  
  521. procedure TFindForm.ListboxClick(Sender: TObject);
  522. begin
  523.   UpdateStatusBar;
  524. end;
  525.  
  526.  
  527. procedure TFindForm.FormPaint(Sender: TObject);
  528. var
  529.   R: TRect;
  530. begin
  531.   Border3D(Canvas, ClientWidth-1, ClientHeight-1);
  532.   R := Rect(4, Listbox.Top + Listbox.Height + 3,
  533.     SelLabel.Left - 10, ClientHeight - 3);
  534.   RecessBevel(Canvas, R);
  535.   R.Left := R.Right + 3;
  536.   R.Right := ClientWidth - 3;
  537.   RecessBevel(Canvas, R);
  538.   Canvas.Draw(ClientWidth-17, ClientHeight-17, Sizebox);
  539. end;
  540.  
  541.  
  542. procedure TFindForm.StartEditDblClick(Sender: TObject);
  543. begin
  544.   SubFolders.Checked := True;
  545.   StartEdit.Text := SelectFolder(StartEdit.Text);
  546. end;
  547.  
  548.  
  549. procedure TFindForm.SettingsChanged(Changes : TSettingChanges);
  550. begin
  551.   if scFileSystem in Changes then Listbox.Invalidate;
  552.  
  553.   if scSystem in Changes then begin
  554.     ini.ReadNewStrings('Search for', FileEdit.Items);
  555.     ini.ReadNewStrings('Start from', StartEdit.Items);
  556.   end;
  557. end;
  558.  
  559. procedure TFindForm.CopyFilenamesClick(Sender: TObject);
  560. var
  561.   strings  : TStringList;
  562.   filename : string[15];
  563.   location : TFilename;
  564.   size     : string[15];
  565.   date     : string[15];
  566.   i        : Integer;
  567.   locwidth : Integer;
  568. begin
  569.   strings := TStringList.Create;
  570.   try
  571.     locwidth := Header.SectionWidth[1] div Canvas.TextWidth('n');
  572.  
  573.     with Listbox do
  574.       for i := 0 to Items.Count-1 do
  575.         if Selected[i] then
  576.           if LongBool(TComponent(Sender).Tag) then begin
  577.             Unformat(Items[i], '%s;%s;%s;%s',
  578.              [@filename, 15, @location, 79, @size, 15, @date, 15]);
  579.             strings.Add(Format('%-12s %-*s %10s %s',
  580.               [filename, locwidth, location, size, date]));
  581.           end
  582.           else
  583.             strings.Add(FilenameAt(i));
  584.  
  585.     CopyStringsToClipboard(strings);
  586.   finally
  587.     strings.Free;
  588.   end;
  589. end;
  590.  
  591. procedure TFindForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  592. begin
  593.   CanClose := not Searching;
  594. end;
  595.  
  596. procedure TFindForm.FormResize(Sender: TObject);
  597. begin
  598.   Invalidate;
  599.   StretchShift([Notebook, Header, FileEdit, StartEdit], [stWidth]);
  600.   StretchShift([SearchBtn, CancelBtn], [stLeft]);
  601.   StretchShift([Bevel3, Listbox], [stWidth, stHeight]);
  602.   StretchShift([FoundLabel, SelLabel], [stTop]);
  603. end;
  604.  
  605. procedure TFindForm.OpenWithClick(Sender: TObject);
  606. var s: TFilename;
  607. begin
  608.   with Listbox do
  609.     if (ItemIndex > -1) and IsFile(ItemIndex) then begin
  610.     ShowHourGlass;
  611.     s := TOpenFileDlg.Execute;
  612.     if s > '' then OpenFileWith(FilenameAt(ItemIndex), s);
  613.   end;
  614. end;
  615.  
  616. end.
  617.