(*  GREATIS FILE SEARCH                       *)
(*  Copyright (C) 2005-2007 Greatis Software  *)
(*  http://www.greatis.com/delphicb/fsearch/  *)
(*  http://www.greatis.com/bteam.html         *)
(*                                            *)
(*  GREATIS DELPHI TOYS                       *)
(*  http://www.greatis.com/delphicb/toys/     *)

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  FSearch, StdCtrls, ShlObj;

type
  TfrmMain = class(TForm)
    cmpFileSearch: TFileSearch;
    edtStartFrom: TEdit;
    lblStartFrom: TLabel;
    btnStartFrom: TButton;
    edtFileMask: TEdit;
    lblFileMask: TLabel;
    btnStart: TButton;
    btnExit: TButton;
    procedure btnStartFromClick(Sender: TObject);
    procedure cmpFileSearchFound(Sender: TObject; FileInfo: TFileInfo;
      var Abort: Boolean);
    procedure btnStartClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure cmpFileSearchFinished(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses Found;

{$R *.DFM}

function BrowseProc(Handle: HWND; Msg: UINT; L,Data: LPARAM): Integer; stdcall;
begin
  Result:=0;
  if Msg=BFFM_INITIALIZED then
    SendMessage(Handle,BFFM_SETSELECTION,1,Data);
end;

procedure TfrmMain.btnStartFromClick(Sender: TObject);
var
  BI: TBrowseInfo;
  Result: PItemIDList;
  Temp: array[0..MAX_PATH] of Char;
begin
  FillChar(BI,SizeOf(BI),0);
  with BI do
  begin
    hwndOwner:=Handle;
    lpszTitle:='Specify search path';
    ulFlags:=BIF_RETURNONLYFSDIRS or BIF_RETURNFSANCESTORS;
    lpfn:=@BrowseProc;
    lParam:=Integer(PChar(edtStartFrom.Text));
    Result:=SHBrowseForFolder(BI);
    if Assigned(Result) then
    begin
      SHGetPathFromIDList(Result,Temp);
      edtStartFrom.Text:=Temp;
    end;
  end;
end;

procedure TfrmMain.cmpFileSearchFound(Sender: TObject; FileInfo: TFileInfo;
  var Abort: Boolean);

  function Truncate(S: string; MaxLen: Integer): string;
  begin
    if S='' then Result:=''
    else
      if Length(S)>MaxLen then
      begin
        Result:=Copy(S,1,Pos('\',S));
        Result:=Result+'...'+Copy(S,Length(S)-MaxLen+Length(Result)+3,Length(S));
      end
      else Result:=S;
  end;

begin
  with FileInfo do
    if not Directory then
      with frmFound do
      begin
        lblFile.Caption:=FileInfo.Name;
        lblFolder.Caption:=Truncate(Path,40);
        if ShowModal<>mrOK then cmpFileSearch.Abort;
      end;
end;

procedure TfrmMain.btnStartClick(Sender: TObject);
begin
  with cmpFileSearch do
  begin
    SearchPath:=edtStartFrom.Text;
    FileMask:=edtFileMask.Text;
    Search;
  end;
end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TfrmMain.cmpFileSearchFinished(Sender: TObject);
begin
  with cmpFileSearch do
    if Aborted then ShowMessage('Search process aborted.')
    else ShowMessage(IntToStr(FileCount)+' file(s) found. No more files.');
end;

end.
