Link to home
Create AccountLog in
Avatar of Marco Gasi
Marco GasiFlag for Spain

asked on

Component archtecture problem

Hi all.

I have a problem with this my component and I need a really expert help. The component performs a search within a specified directory for files referring to a specified mask: the mask can be one or more extensions separated by semicolon.

The problem is this. You can set an event to be raised when a single search is completed

mgFL.SearchList.Add;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].Title := 'Title';
mgFL.SearchList.Items[mgFL.SearchList.Count-1].Mask := '*';
mgFL.SearchList.Items[mgFL.SearchList.Count-1].SearchPath := some path;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].SearchResult := myStringList;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].OutputDevice := myTreeView;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].RecursiveSearch := True;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].OnSearchCompleted := MyEvent;
mgFL.DoSingleSearch(mgFL.SearchList.Count-1);

Open in new window

This way the event is correctly raised.

You can also set an event to be raised when all searches are terminated:
mgFL.SearchList.Add;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].Title := 'Title1';
mgFL.SearchList.Items[mgFL.SearchList.Count-1].Mask := '*';
mgFL.SearchList.Items[mgFL.SearchList.Count-1].SearchPath := some path1;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].SearchResult := myStringList1;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].OutputDevice := myTreeView1;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].RecursiveSearch := True;
mgFL.SearchList.Add;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].Title := 'Title2';
mgFL.SearchList.Items[mgFL.SearchList.Count-1].Mask := '*';
mgFL.SearchList.Items[mgFL.SearchList.Count-1].SearchPath := some path2;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].SearchResult := myStringList2;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].OutputDevice := myTreeView1;
mgFL.SearchList.Items[mgFL.SearchList.Count-1].RecursiveSearch := True;

mgFL.OnCompleteSearchs := MyEvent_for_all;
mgFL.DoAllSearches;

Open in new window


This way works fine also and trhe event is correctly raised. But suppose to have the last code and to change only last two lines this way:
mgFL.OnCompleteSearchs := MyEvent_for_all;
for I := ActualSearchCount - 1 to mgFL.SearchList.Count - 1 do
  mgFL.DoSingleSearch(I);

Open in new window


This time the event is not raised at all and I don't understand how I can fix this.
Please, help me. Below you can find the full code of my component:
unit UmgFileListator;
//{$DEFINE shareware}

interface

uses
  Windows,
  SysUtils,
  Messages,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  Menus,
  StdCtrls,
  ExtCtrls,
  ComCtrls,
  StrUtils,shellapi;

type
  TmgFileListator = class;

  TmgSearchList = class;

  TmgSearch = class;

  TSearchKind = (skFiles, skFolders);

  {TmgSearchThread has responsability to search over the defined path all files matching
  specified criteria. As search goes on, TmgSearchThread put reaults in output device
  and refresh progress label caption.
  When executed, TmgSearchThread put itself in a list of running searches mantained by
  TmgSearchList and when destroyed remove itself from this list.}
  TmgSearchThread = class(TThread)
  private
    FileCounter: Integer;
    SearchPath: string;
    FMask: string;
    FTitle: string;
    FMultipleExt: Boolean;
    FSearchKind: TSearchKind;
    ActiveComponent: TComponent;
    AddStr, NodeStr: string;
    FSearchFile: string;
    FRecursiveSearch: Boolean;
    ActiveFolder: string;
    ExtList: TStringList;
    SearchingLabel: TLabel;
    TV: TTreeView;
    PrevTN, CurrentTN, TNItem, TN: TTreeNode;
    Recursion: Boolean;
    mgSearch: TmgSearch;
    FIssue: string;
    procedure AddToList;
    procedure AddToStringList;
    procedure FixControls;
    procedure SetSearchFile;
    procedure FindFiles(APath: String);
    function GetDirectoryName(Dir: String): String;
    procedure Split(Delimiter: Char; Input: string; const Strings: TStrings);
    procedure GetSubDirs (Folder: string; sList: TStringList);
  protected
  {Execute is internally called to begin a search job. Don't try to call directly
  Execute method to avoid conflicts and unpredictable unwanted behaviors: call
  @link(DoSingleSearch) or @link(DoAllSearches) instead.}
    procedure Execute; override;
  public
  {Creates search thread launching searching operation over the computer. Don't
  call it directly but call @link(DoSingleSearch) and @link(DoAllSearches) methods instead.
  Search can be invoked with different parameters according to wether user has
  set OutputDevice and ProgressDevice or not.}
    constructor Create(const APath, AMask, ATitle: string;
                       ASearchKind: TSearchKind; Output: TTreeView;
                       ProgressLabel: TLabel; AOwner: TmgSearch;
                       Recursive, ToSplit: Boolean); overload;
    constructor Create(const APath, AMask, ATitle: string;
                       ASearchKind: TSearchKind; ProgressLabel: TLabel;
                       AOwner: TmgSearch; Recursive, ToSplit: Boolean); overload;
    constructor Create(const APath, AMask, ATitle: string;
                       ASearchKind: TSearchKind; Output: TTreeView;
                       AOwner: TmgSearch; Recursive, ToSplit: Boolean); overload;
    constructor Create(const APath, AMask, ATitle: string;
                       ASearchKind: TSearchKind; AOwner: TmgSearch;
                       Recursive, ToSplit: Boolean); overload;
   {Never call Destroy method directly. Use @link(StopASearch) and @link(StopAllSearches) instead.}
    destructor Destroy; override;
  end;

  {TmgSearch mantains all data that are needed to make a search and starts searches
  when receives command by @link(TmgSearchList().}
  TmgSearch = class(TCollectionItem)
  private
    FTitle: string;
    FMask: string;
    FPath: string;
    FSearchName: string;
    FSearchCompleted: Boolean;
    FOnSearchCompleted: TNotifyEvent;
    FSearchResult: TStrings;
    FSearchKind: TSearchKind;
    FStopOnFind: Boolean;
    FOutputDevice: TTreeView;
    FProgressDevice: TLabel;
    FRecursive: Boolean;
    FRunning: Boolean;
    FSearchThread: TmgSearchThread;
    FSearchList: TmgSearchList;
    procedure CompleteSearch(Sender: TObject);
  protected
    function GetDisplayName: string; override;
    procedure DoCompleteSearch;
  {Called internally to set Mask value. Don't try to call it directly but use @link(Mask) property instead.}
    procedure SetMask(Value: string);
  {Called internally to set Path value. Don't try to call it directly but use @link(SearchPath) property instead.}
    procedure SetPath(Value: string);
  {Called internally to set Title value. Don't try to call it directly but use @link(Title) property instead.}
    procedure SetTitle(Value: string);
  {Called internally to determine the search type}
    procedure SeTSearchKind(Value: TSearchKind);
  {Called internally to set OutputDevie value. Don't try to call it directly but use @link(OutputDevie) property instead.}
    procedure SetOutputDevice(Value: TTreeView);
  {Called internally to set ProgressDevice value. Don't try to call it directly but use @link(ProgressDevice) property instead.}
    procedure SetProgressDevice(Value: TLabel);
  {Called internally to set Running value. Don't try to call it directly but use @link(Running) property instead.}
    procedure SetRunning(Value: Boolean);
  {This procedure is called internally to update the OutputDevice data. You shouldn't never try to call Change procedure directly.}
    procedure Change;
  {Called internally to notify component if one of the associated components (TTreeView or TLabel) has been removed
  from the main form, so to allow to component to update its properties values.}
    procedure Notification(AComponent: TComponent; Operation: TOperation);
  {Flag used internally to determine the search status and change accordingly some variables. If Running is True,
  the animation component is visible and active, otherwise its Visible property and its Active property are set
  to False. This value is reflected by @link(RunningSearch) property value of TmgFileListator.}
    property Running: Boolean read FRunning write SetRunning;
  public
  {Do not call Create to instantiate a mgSearch item. Instead, call the @link(Add) method of the
  mgSearchList to which the item should belong.
  Collection identifies the TCollection instance (a @link(TmgSearchList) component) to which the new item belongs.}
    constructor Create(Collection: TCollection); override;
  {Destroy is called indirectly by TmgSearchList’s Clear or Delete method.}
    destructor Destroy; override;
  {}
    property SearchResult: TStrings read FSearchResult write FSearchResult;
    property SearchCompleted: Boolean read FSearchCompleted;
  {In Assign procedure are set some values to ensure a correct streaming process of mgSearch values.}
    procedure Assign(Source: TPersistent); override;
  {Called internally to launch a specific search thread. Use @link(DoSingleSearch) and @link(DoAllSearches) method instead.}
    procedure SearchForMatch;
  published
    property SearchName: string read FSearchName write FSearchName;
  {Set Title property to give a unique custom identity to a new search. If leaved blank, @link(TmgFileListator)
  provides a Title for you.}
    property Title: string read FTitle write SetTitle;
  {Set ProgressDevice property to determine wich TLabel component has to reflect the search's progress.}
    property ProgressDevice: TLabel read FProgressDevice write SetProgressDevice;
  {Set RecursiveSearch property to specify if search has to recurse between subfolders or not.}
    property RecursiveSearch: Boolean read FRecursive write FRecursive default True;
  {Set Mask to specify what you wish to look for. Mask can be a file extension , a file extension group
  or even a word or a letter's group. In all cases, you must remember to use wildcards '*'.
  One extension has to be specified with this syntax: *.txt.
  The extension groups consists in a series of extensions separated by a semicolon: (*.txt;*.doc;*.pdf).
  Words and letter's groups must be written as in following examples:
  '*land Delp*.msi'
  'Borlan*.*
  Borland Delphi.*}
    property Mask: string read FMask write SetMask;
  {SearchKind specifies if the search has to find files only, folders only or both files and folders}
    property SearchKind: TSearchKind read FSearchKind write SeTSearchKind;
  {SearchPath specifies the start folder of your search. If RecursiveSearch is set to True, search will
  scan all subfolders also.}
    property SearchPath: string read FPath write SetPath;
  {Set OutputDevice property to determine wich TTreeView component has to receive the search's results.}
    property OutputDevice: TTreeView read FOutputDevice write SetOutputDevice;
    property StopOnFind: Boolean read FStopOnFind write FStopOnFind;
    property OnSearchCompleted: TNotifyEvent read FOnSearchCompleted write FOnSearchCompleted;
  end;

  {The search collection contains some basic properties and methods to
  allow to the user of TmgFileListator to set, launch and stop mgSearches.}
  TmgSearchList = class(TCollection)
  private
    FRunningSearches: TStringList;
    FFListator: TmgFileListator;
    function GetItem(Index: Integer): TmgSearch;
    procedure SetItem(Index: Integer; Value: TmgSearch);
    procedure AddRunningSearch(Title: string);
    procedure RemoveRunningSearch(Title: string);
  protected
  public
  {You don't need to call Create event to create a TmgSearchList. This job is done
  by TmgFileListator instance wich owns the collection}
    constructor Create(FileListator: TmgFileListator);
  {Don't call Destroy directly to destroy a TmgSearchList created at runtime, but
  call Free metthod instead.}
    destructor Destroy; override;
  {Call Add method to create a new TmgSearch and to add it to mgSearchList.}
    function Add: TmgSearch;
  {Use Items property to get access to a specific mgSearch in the collection and to its properties.}
    property Items[Index: Integer]: TmgSearch read GetItem write SetItem; default;
  end;

  TCompleteEvent = procedure (Sender: TObject; IsCompleted: Boolean) of object;

  {This simple component allows to averyone to easy launch and manage an infinite
  number of simulataneous file searches over its PC, specifiyng different criteria
  and receiving search output in specified device (actually only TTreeView is
  supported) User can set an animation also, using standard Windows avi or even
  converting its own animated gif into avi format and loading them in TAnimate
  component supported by TmgFileListator.}
  TmgFileListator = class(TComponent)
  private
    FRunningSearch: Boolean;
    FOnComplete: TNotifyEvent;
    FCompleted: Boolean;
    FSearchList: TmgSearchList;
    FAnimation: TAnimate;
//    procedure Complete(Sender: TObject);
  protected
  {Used internally: set the TmgSearchList component you can access through SearchList property.}
    procedure SetSearchList(Value: TmgSearchList);
  {Notifies TmgFilelIstator if an associated TAnimate component has been removed from the form.
  You'll never need to call directly this method.}
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  {Used internally to set Animation property assigning a TAnimate component.}
    procedure SetAnimation(Value: TAnimate);
  {Used internally to set Running property.}
    procedure SetRunningSearch(Value: Boolean);
    {}
    procedure DoComplete;
  {Running property specifies if a search is actually running over the computer and it is used
  internally by @link(TmgSearch).}
    property Running: Boolean read FRunningSearch write SetRunningSearch;
  public
  {Call Create method to instantiate a new TmgFileListator at runtime. AOwner indicates
  the owner of the new TmgFileListator, tipically a form. If TmgFileListator is created at
  design time, placing it in the form designer, Create method is called internally.}
    constructor Create(AOwner: TComponent); override;
  {As usual, you don't have to call Destroy method directly. Use Free method instead.}
    destructor Destroy; override;
  {Modifies data of an existing mgSearch}
    procedure EditSearch(ATitle, AMask, APath: string; AOutputDevice: TTreeView;
          AProgressdevice: TLabel; ARecursive: Boolean; Index: Integer);
  {Start all searches mantained in TmgSearchList and print their results in the @link(OutputDevice).}
    procedure DoAllSearches;
  {Start the search contained in TmgSearchList idenfified by its Index value and print its
  results in the @link(OutputDevice).}
    procedure DoSingleSearch(Index: Integer);
  {Immediatly terminates all searches threads actually running.}
    procedure StopAllsearches;
  {Immediatly terminates the searh thread actually running identified by its Index value.}
    procedure StopASearch(Index: Integer);
  {Deletes the mgSearch contained in the TmgSearchList identified by its Index value
  without deleting its results from the @link(OutputDevice).}
    procedure DeleteSearch(Index: Integer);
  {Deletes all the results of the mgSearch contained in TmgSearchList identified by its
  Index value but not removes the mgSearch itself from TmgSearchList.}
    procedure DeleteResults(Index: Integer);
  {Deletes the mgSearch contained in the TmgSearchList identified by its Index value and
  all its results from the @link(OutputDevice).}
    procedure DeleteSearchAndResults(Index: Integer);
  {Deletes all mgSearch instances containde in TmgSearchList without deleting their
  results from the Output devices.}
    procedure DeleteAllSearches;
  {Deletes the results of all mgSearch instances from Output devices withou deleting
  mgSearch instances itself form TmgSearchList.}
    procedure DeleteAllResults;
  {Deletes all mgSearch instances and all their results from Output devices.}
    procedure DeleteAllSearchesAndResults;
  {RunningSearch property reflects Running property value to allow to the user to know
  TgFilelistator status.}
    property RunningSearch: Boolean read FRunningSearch;
    property Completed: Boolean read FCompleted write FCompleted;
  published
  {Set Animation property to associate a TAnimate component to display an animation while
  TmgFileListator is running.}
    property Animation: TAnimate read FAnimation write SetAnimation;
  {Gives access to TmgSearchList to manage each TmgSearch's values.}
    property SearchList: TmgSearchList read FSearchList write SetSearchList;
    {}
    property OnCompleteSearchs: TNotifyEvent read FOnComplete write FOnComplete;
  end;

implementation

{ TmgSearchThread}

procedure TmgSearchThread.AddToList;
begin
  if ActiveComponent <> nil then
  begin
    if AnsiStartsText(CurrentTN.Text, NodeStr) then
      TNItem := TV.Items.AddChild(CurrentTN, AddStr)
    else
      TNItem := TV.Items.AddChild(TN, AddStr);
  end;
end;

procedure TmgSearchThread.AddToStringList;
begin
  if Assigned(mgSearch.FSearchResult) then
    mgSearch.FSearchResult.Add(AddStr);
end;

constructor TmgSearchThread.Create(const APath, AMask, ATitle: string;
  ASearchKind: TSearchKind; Output: TTreeView; ProgressLabel: TLabel;
  AOwner: TmgSearch; Recursive, ToSplit: Boolean);
begin
  FMask := AMask;
  FTitle := ATitle;
  FSearchKind := ASearchKind;
  FMultipleExt := ToSplit;
  SearchingLabel := ProgressLabel;
  ActiveComponent := Output;
  FRecursiveSearch := Recursive;
  SearchPath := APath;
  FileCounter := 0;
  mgSearch := AOwner;
  inherited Create(False);
end;

constructor TmgSearchThread.Create(const APath, AMask, ATitle: string;
  ASearchKind: TSearchKind; ProgressLabel: TLabel; AOwner: TmgSearch;
  Recursive, ToSplit: Boolean);
begin
  FMask := AMask;
  FTitle := ATitle;
  FSearchKind := ASearchKind;
  FMultipleExt := ToSplit;
  SearchingLabel := ProgressLabel;
  FRecursiveSearch := Recursive;
  SearchPath := APath;
  FileCounter := 0;
  mgSearch := AOwner;
  inherited Create(False);
end;

constructor TmgSearchThread.Create(const APath, AMask, ATitle: string;
  ASearchKind: TSearchKind; Output: TTreeView; AOwner: TmgSearch;
  Recursive, ToSplit: Boolean);
begin
  FMask := AMask;
  FTitle := ATitle;
  FSearchKind := ASearchKind;
  FMultipleExt := ToSplit;
  ActiveComponent := Output;
  FRecursiveSearch := Recursive;
  SearchPath := APath;
  FileCounter := 0;
  mgSearch := AOwner;
  inherited Create(False);
end;

constructor TmgSearchThread.Create(const APath, AMask, ATitle: string;
  ASearchKind: TSearchKind; AOwner: TmgSearch; Recursive, ToSplit: Boolean);
begin
  FMask := AMask;
  FTitle := ATitle;
  FSearchKind := ASearchKind;
  FMultipleExt := ToSplit;
  FRecursiveSearch := Recursive;
  SearchPath := APath;
  FileCounter := 0;
  mgSearch := AOwner;
  inherited Create(False);
end;

destructor TmgSearchThread.Destroy;
begin
  FSearchFile := '';
  Synchronize(FixControls);
  inherited Destroy;
end;


procedure TmgSearchThread.Execute;
var
  I: Integer;
begin
  FreeOnTerminate := True;
  mgSearch.FRunning := True;
  TmgSearchList(mgSearch.Collection).AddRunningSearch(mgSearch.Title);
  if FMultipleExt then
  begin
    if ActiveComponent <> nil then
    begin
      TV := TTreeView(ActiveComponent);
      TN := TV.Items.AddChild(nil, FTitle);
      CurrentTN := TN;
      PrevTN := TN;
      ExtList := TStringList.Create;
      try
        Split(';', FMask, ExtList);
        for i := 0 to ExtList.Count -1 do
        begin
          FMask := ExtList[i];
          ActiveFolder := SearchPath;
          FindFiles(SearchPath);
        end;
      finally
        ExtList.Free;
      end;
    end
    else
    begin
//      FThreadSearchResult.Clear;
      ExtList := TStringList.Create;
      try
        Split(';', FMask, ExtList);
        for i := 0 to ExtList.Count -1 do
        begin
          FMask := ExtList[i];
          ActiveFolder := SearchPath;
          FindFiles(SearchPath);
        end;
      finally
        ExtList.Free;
      end;
    end;
  end
  else
  begin
    if ActiveComponent <> nil then
    begin
      TV := TTreeView(ActiveComponent);
      TN := TV.Items.AddChild(nil, FTitle);
      CurrentTN := TN;
      PrevTN := TN;
      ActiveFolder := SearchPath;
      FindFiles(SearchPath);
    end
    else
    begin
      ActiveFolder := SearchPath;
      FindFiles(SearchPath);
    end;
  end;
end;

procedure TmgSearchThread.FindFiles(APath: String);
var
  AnyFSearchRec,
  FSearchRec,
  DSearchRec, sr: TSearchRec;
  FindResult: integer;
  OriginalPath: string;
  sDirList: TStringList;
  i: Integer;

  function IsDirNotation(ADirName: String): Boolean;
  begin
    Result := (ADirName = '.') or (ADirName = '..');
  end;

begin
  case FSearchKind of
    skFiles:
      begin
        Recursion := False;
        FSearchFile := APath + FMask;
        APath := IncludeTrailingPathDelimiter(APath);
        NodeStr := APath;
        if FindFirst (APath + FMask, faAnyFile, sr) = 0 then
        repeat
          if not IsDirNotation(sr.Name) then
          begin
            AddStr := APath+sr.Name;
            Synchronize(AddToList);
            Synchronize(AddToStringList);
            Synchronize(SetSearchFile);
            Inc(FileCounter);
            if mgSearch.FStopOnFind then
              Terminate;
          end;
        until FindNext(sr) <> 0;
        FindClose(sr);
        if FRecursiveSearch then
        begin
          sDirList := TStringList.Create;
          try
            GetSubDirs (APAth, sDirList);
            for i := 0 to sDirList.Count - 1 do
              if not IsDirNotation(sDirList[i]) then
              begin
                FindFiles (IncludeTrailingPathDelimiter(APath + sDirList[i]));
              end;
          finally
            sDirList.Free;
          end;
        end;
      end;
    skFolders:
      begin
        if FMask = '' then
        begin
          OriginalPath := APath;
          Recursion := False;
          FSearchFile := APath + FMask;
          APath := GetDirectoryName(APath);
          NodeStr := APath;
          try
            if FindFirst(IncludeTrailingPathDelimiter(APath) + '*.*', faDirectory, sr) < 0 then
              Exit
            else
            repeat
              if (sr.Attr and faDirectory <> 0) and (not IsDirNotation(sr.Name)) then
              begin
                AddStr := IncludeTrailingPathDelimiter(APath) + sr.Name;
                Synchronize(AddToList);
                Synchronize(AddToStringList);
                Synchronize(SetSearchFile);
                Inc(FileCounter);
                if mgSearch.FStopOnFind then
                  Terminate;
              end;
            until FindNext(sr) <> 0;
            FindResult := FindFirst(IncludeTrailingPathDelimiter(APath)+'*.*', faDirectory, DSearchRec);
            if FRecursiveSearch then
            begin
              while (FindResult = 0) and not Terminated do
              begin
                if ((DSearchRec.Attr and faDirectory) = faDirectory) and not
                  IsDirNotation(DSearchRec.Name) then
                  begin
                    Recursion := True;
                    FindFiles(IncludeTrailingPathDelimiter(APath+DSearchRec.Name)); // Recursion here
                  end;
                FindResult := FindNext(DSearchRec);
              end;
            end;
          finally
            SysUtils.FindClose(sr) ;
          end;
        end
        else
        begin
          OriginalPath := APath;
          Recursion := False;
          FSearchFile := APath + FMask;
          APath := GetDirectoryName(APath);
          NodeStr := APath;
          FindResult := FindFirst(APath+FMask,faDirectory+faHidden,FSearchRec);
          FindFirst(APath, faDirectory, AnyFSearchRec);
          try
            while (FindResult = 0) and not Terminated do
            begin
              AddStr := IncludeTrailingPathDelimiter(APath) + FSearchRec.Name;
              Synchronize(AddToList);
              Synchronize(AddToStringList);
              Synchronize(SetSearchFile);
              Inc(FileCounter);
              if not mgSearch.FStopOnFind then
                FindResult := FindNext(FSearchRec)
              else
                Terminate;
            end;

            FindResult := FindFirst(APath+'*.*', faDirectory, DSearchRec);
            if FRecursiveSearch then
            begin
              while (FindResult = 0) and not Terminated do
              begin
                if ((DSearchRec.Attr and faDirectory) = faDirectory) and not
                  IsDirNotation(DSearchRec.Name) then
                  begin
                    Recursion := True;
                    FindFiles(APath+DSearchRec.Name); // Recursion here
                  end;
                FindResult := FindNext(DSearchRec);
              end;
            end;
          finally
            SysUtils.FindClose(FSearchRec);
          end;
        end;
      end;
  end;// end case
end;

procedure TmgSearchThread.FixControls;
begin
  mgSearch.FRunning := False;
//  mgSearch.CompleteSearch(Self);
  FIssue := 'Number of searchs ' + IntToStr(TmgSearchList(mgSearch.Collection).Count);
  try
    TmgSearchList(mgSearch.Collection).RemoveRunningSearch(mgSearch.Title);
  except
  end;
  if Assigned(SearchingLabel) then
    SearchingLabel.Caption := '';
  if ActiveComponent <> nil then
    if FileCounter = 0 then
      TNItem := TV.Items.AddChild(CurrentTN, 'Sorry, none file matching your criteria was found.');
end;

function TmgSearchThread.GetDirectoryName(Dir: String): String;
begin
  if Dir[Length(Dir)]<> '\' then
    Result := Dir+'\'
  else
    Result := Dir;
end;

procedure TmgSearchThread.GetSubDirs(Folder: string; sList: TStringList);
var
  sr: TSearchRec;
begin
    if FindFirst (Folder + '*.*', faDirectory, sr) = 0 then
    try
      repeat
        if (sr.Attr and faDirectory) = faDirectory then
          sList.Add (sr.Name);
      until FindNext(sr) <> 0;
    finally
      FindClose(sr);
    end;
end;

procedure TmgSearchThread.SetSearchFile;
begin
  if SearchingLabel <> nil then
    SearchingLabel.Caption := AddStr;
end;

procedure TmgSearchThread.Split(Delimiter: Char; Input: string;
  const Strings: TStrings);
begin
  Assert(Assigned(Strings)) ;
  Strings.Clear;
  Strings.Delimiter := Delimiter;
  Strings.DelimitedText := Input;
end;


{ TmgSearch }

procedure TmgSearch.Assign(Source: TPersistent);
begin
  if Source is TmgSearch then
  begin
    Title := TmgSearch(Source).Title;
    SearchPath := TmgSearch(Source).SearchPath;
    Mask :=  TmgSearch(Source).Mask;
//    SearchResult := TStringList.Create;
    if Assigned(SearchResult) then
      SearchResult.Assign(TmgSearch(Source).SearchResult);
    OutputDevice := TmgSearch(Source).OutputDevice;
    ProgressDevice :=  TmgSearch(Source).ProgressDevice;
    RecursiveSearch :=  TmgSearch(Source).RecursiveSearch;
    SearchKind :=  TmgSearch(Source).SearchKind;
    Exit;
  end;
  inherited Assign(Source);
end;

procedure TmgSearch.Change;
var
  i: Integer;
  tv: TTreeView;
  tn, tntd: TTreeNode;
begin
  if Assigned(FOutputDevice) then
  begin
    tv := FOutputDevice;
    if tv.Items.Count > 0 then
    begin
      tn := tv.Items[0];
      for i := tv.Items.Count - 1 downto 0 do
        if tv.Items[i].Text = FTitle then
          tn := tv.Items.Item[i];
      if tn <> nil then
      begin
        while tn.HasChildren do
        begin
          tntd := tn.GetFirstChild;
          tv.Items.Delete(tntd);
          if not tn.HasChildren then
            tv.Items.Delete(tn);
        end;
      end;
    end;
  end;
end;

procedure TmgSearch.CompleteSearch(Sender: TObject);
begin
  FSearchCompleted := True;
  DoCompleteSearch;
end;

constructor TmgSearch.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FSearchName := '';
  FRecursive := True;
  FRunning := False;
  FSearchKind := skFiles;
  FSearchList := TmgSearchList(Collection);
  FStopOnFind := False;
  FSearchCompleted := False;
  if FMask = '' then FMask := '*.*';
end;

destructor TmgSearch.Destroy;
begin
  if FRunning then
    FSearchThread.Terminate;
  inherited Destroy;
end;

procedure TmgSearch.DoCompleteSearch;
begin
  if Assigned(FOnSearchCompleted) then
    FOnSearchCompleted(Self);
end;

function TmgSearch.GetDisplayName: string;
begin
  Result := Trim(FSearchName);
  if Result = '' then Result := inherited GetDisplayName;
end;

procedure TmgSearch.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FOutputDevice) then
    FOutputDevice.Free
  else
  if (Operation = opRemove) and (AComponent = FProgressDevice) then
    FProgressDevice.Free;
end;

procedure TmgSearch.SearchForMatch;
begin
  if FPath = '' then
    MessageDlg('Set a search path first, please.', mtInformation, [mbOK], 0)
  else
  begin
    if FOutputDevice <> nil then
    begin
      if FOutputDevice.Items.Count > 0 then
        if FOutputDevice.Items[0].Text = FTitle then
          Change;
    end;
    if (FOutputDevice <> nil) and (FProgressDevice <> nil) then
    begin
      if Pos(';', FMask) <> 0 then
         FSearchThread := TmgSearchThread.Create(FPath, FMask, FTitle,
             FSearchKind, FOutputDevice, FProgressDevice, Self, FRecursive, True)
      else
         FSearchThread := TmgSearchThread.Create(FPath, FMask, FTitle,
             FSearchKind, FOutputDevice, FProgressDevice, Self, FRecursive, False);
      FSearchThread.OnTerminate := CompleteSearch;
    end
    else
    if (FOutputDevice = nil) and (FProgressDevice = nil) then
    begin
      if Pos(';', FMask) <> 0 then
         FSearchThread := TmgSearchThread.Create(FPath, FMask, FTitle,
             FSearchKind, Self, FRecursive, True)
      else
         FSearchThread := TmgSearchThread.Create(FPath, FMask, FTitle,
             FSearchKind, Self, FRecursive, False);
      FSearchThread.OnTerminate := CompleteSearch;
    end
    else
    if FOutputDevice = nil then
    begin
      if Pos(';', FMask) <> 0 then
         FSearchThread := TmgSearchThread.Create(FPath, FMask, FTitle,
             FSearchKind, FProgressDevice, Self, FRecursive, True)
      else
         FSearchThread := TmgSearchThread.Create(FPath, FMask, FTitle,
             FSearchKind, FProgressDevice, Self, FRecursive, False);
      FSearchThread.OnTerminate := CompleteSearch;
    end
    else
    if FProgressDevice = nil then
    begin
      if Pos(';', FMask) <> 0 then
         FSearchThread := TmgSearchThread.Create(FPath, FMask, FTitle,
             FSearchKind, FOutputDevice, Self, FRecursive, True)
      else
         FSearchThread := TmgSearchThread.Create(FPath, FMask, FTitle,
             FSearchKind, FOutputDevice, Self, FRecursive, False);
      FSearchThread.OnTerminate := CompleteSearch;
    end;
  end;
end;

procedure TmgSearch.SetMask(Value: string);
var
  oldVal: string;
begin
  oldVal := FMask;
  if (FMask = '') or (Value <> FMask) then
    Change;
  FMask := Value;
  if FTitle = '' then
    FTitle := FMask
  else
  if AnsiContainsText(FTitle, oldVal) then
    FTitle := AnsiReplaceText(FTitle, oldVal, Value);
end;

procedure TmgSearch.SetOutputDevice(Value: TTreeView);
begin
  FOutputDevice := Value;
end;

procedure TmgSearch.SetPath(Value: string);
var
  oldVal: string;
begin
  oldVal := FPath;
  if (FPath = '') or (Value <> FPath) then
    Change;
  FPath := Value;
  if FTitle = '' then
    FTitle := FPath
  else
  if AnsiContainsText(FTitle, oldVal) then
    FTitle := AnsiReplaceText(FTitle, oldVal, Value);
end;

procedure TmgSearch.SetProgressDevice(Value: TLabel);
begin
  if FProgressDevice <> Value then
    FProgressDevice := Value;
end;

procedure TmgSearch.SetRunning(Value: Boolean);
begin
  FRunning := Value;
end;

procedure TmgSearch.SeTSearchKind(Value: TSearchKind);
begin
  FSearchKind := Value;
end;

procedure TmgSearch.SetTitle(Value: string);
begin
  FTitle := Value;
end;

{ TmgSearchList }

function TmgSearchList.Add: TmgSearch;
begin
  Result := TmgSearch(inherited Add);
end;

procedure TmgSearchList.AddRunningSearch(Title: string);
begin
  FRunningsearches.Add(Title);
  if FRunningSearches.Count => 1 then
    FFListator.Running := True;
end;

constructor TmgSearchList.Create(FileListator: TmgFileListator);
begin
  inherited Create(TmgSearch);
  FFListator := FileListator;
  FRunningSearches := TStringList.Create;
end;

destructor TmgSearchList.Destroy;
begin
  FRunningSearches.Free;
  inherited;
end;

function TmgSearchList.GetItem(Index: Integer): TmgSearch;
begin
  Result := TmgSearch(inherited GetItem(Index));
end;

procedure TmgSearchList.RemoveRunningSearch(Title: string);
begin
  if FRunningSearches.Count = 1 then
  begin
    FFListator.Running := False;
    FFListator.Completed := True;
    FFListator.DoComplete;
    FRunningsearches.Delete(FRunningSearches.IndexOf(Title));
  end
  else
    FRunningsearches.Delete(FRunningSearches.IndexOf(Title));
end;

procedure TmgSearchList.SetItem(Index: Integer; Value: TmgSearch);
begin
  inherited SetItem(Index, Value);
end;

{TmgFileListator}

destructor TmgFileListator.Destroy;
begin
  FSearchList.Free;
  inherited Destroy;
end;

constructor TmgFileListator.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSearchList := TmgSearchList.Create(Self);
  Running := False;
  Completed := False;
end;

procedure TmgFileListator.SetSearchList(Value: TmgSearchList);
begin
  FSearchList.Assign(Value);
end;

procedure TmgFileListator.DoAllsearches;
var
  I: Integer;
begin
  for I := 0 to FSearchList.Count - 1 do
    FSearchList.Items[i].SearchForMatch;
end;

procedure TmgFileListator.DoSingleSearch(Index: Integer);
begin
  FSearchList.Items[Index].SearchForMatch;
end;

procedure TmgFileListator.StopAllsearches;
var
  I: Integer;
begin
  for I := FSearchList.Count - 1 downto 0 do
    if FSearchList.Items[i].FRunning then
      FSearchList.Items[i].FSearchThread.Terminate;
end;

procedure TmgFileListator.StopASearch(Index: Integer);
begin
  if FSearchList.Items[Index].FRunning then
    FSearchList.Items[Index].FSearchThread.Terminate;
end;

procedure TmgFileListator.SetAnimation(Value: TAnimate);
begin
  FAnimation := Value;
end;

procedure TmgFileListator.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FAnimation) then
    FAnimation := nil;
end;

procedure TmgFileListator.SetRunningSearch(Value: Boolean);
begin
  FRunningSearch := Value;
  if Assigned(FAnimation) then
    FAnimation.Active := RunningSearch;
end;

procedure TmgFileListator.DeleteAllResults;
var
  i: Integer;
begin
  if SearchList.Count > 0 then
    for I := SearchList.Count - 1 downto 0 do
      SearchList.Items[i].Change;
end;

procedure TmgFileListator.DeleteAllSearches;
var
  i: Integer;
begin
  if SearchList.Count > 0 then
    for I := SearchList.Count - 1 downto 0 do
      SearchList.Delete(i);
end;

procedure TmgFileListator.DeleteAllSearchesAndResults;
var
  i: Integer;
begin
  if SearchList.Count > 0 then
    for I := SearchList.Count - 1 downto 0 do
    begin
      SearchList.Items[i].Change;
      SearchList.Delete(i);
    end;
end;

procedure TmgFileListator.DeleteResults(Index: Integer);
begin
  SearchList.Items[Index].Change;
end;

procedure TmgFileListator.DeleteSearch(Index: Integer);
begin
  SearchList.Delete(Index);
end;

procedure TmgFileListator.DeleteSearchAndResults(Index: Integer);
begin
  SearchList.Items[Index].Change;
  SearchList.Delete(Index);
end;

procedure TmgFileListator.EditSearch(ATitle, AMask, APath: string; AOutputDevice: TTreeView;
                AProgressdevice: TLabel; ARecursive: Boolean; Index: Integer);
var
  customTitle: Boolean;
begin
  customTitle := False;
  try
    if ATitle <> SearchList.Items[Index].FTitle then
      customTitle := True;
    SearchList.Items[Index].FOutputDevice := AOutputDevice;
    SearchList.Items[Index].FProgressDevice := AProgressdevice;
    SearchList.Items[Index].FRecursive := ARecursive;
    SearchList.Items[Index].Mask := AMask;
    SearchList.Items[Index].SearchPath := APath;
    if customTitle then
      SearchList.Items[Index].FTitle := ATitle;
  except
    MessageDlg('Some error occurred during editing operations.', mtInformation, [mbOK], 0);
  end;
end;

procedure TmgFileListator.DoComplete;
begin
  if Assigned(FOnComplete) then
     FOnComplete(Self);
end;

end.

Open in new window


Thanks in advance for your precious help.

Cheers
Marco
ASKER CERTIFIED SOLUTION
Avatar of Sinisa Vuk
Sinisa Vuk
Flag of Croatia image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Avatar of Marco Gasi

ASKER

Thank you so mutch, sinisav. It works fine now. I think is the first fix (RunningSearch > 1 instead of RunningSearch = 1) which solved the specific problem, but I would award some bonus points for having read the whole code and suggested other improvements.
Thank you again.