?
Solved

To Geobul

Posted on 2001-07-01
2
Medium Priority
?
161 Views
Last Modified: 2010-08-05
To Geobul

Hello
I have problem with the stop funktion you made for me.
If I search my big hd (40gig) and set mask to a file not exist.
Like *.ggg it is almost impossible to stop the procedure.
I need this to be fixed. please help me.  

If you don?t remeber the Procedure here it is.

procedure GetFiles(FromDir, Mask: String; IncludeSubdirs : boolean; List: TListBox);
 var
 DirInfo: TSearchRec;
 R, ii, i: Integer;
 DirList: TStringList;

begin

 if FromDir[Length(FromDir)] <> '\' then FromDir := FromDir + '\';
 DirList := TStringList.Create;
try
if not StopFind then begin
 if IncludeSubdirs then begin
  R := FindFirst(FromDir + '*.*', faDirectory, DirInfo);
  if R = 0 then begin
   repeat
    if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then begin
      DirList.Add(FromDir + DirInfo.Name);

    end;
    R := FindNext(DirInfo);
   until R <> 0;
   FindClose(DirInfo);
  end;
 end;
 end;
 R := FindFirst(FromDir + Mask, faAnyfile, DirInfo);
form1.StatusBar1.Panels[2].Text:=FromDir + DirInfo.Name + '\';
 if R = 0 then begin
  repeat
      if not StopFind then begin
    if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then begin
      if (((DirInfo.Attr and faDirectory) <> 0) and IncludeSubdirs) then GetFiles(FromDir + DirInfo.Name
+ '\', Mask, IncludeSubdirs, List)

        else List.Items.Add(FromDir + DirInfo.Name);
      end;
    end;
    R := FindNext(DirInfo);
  until R <> 0;
  FindClose(DirInfo);
 end;
Application.ProcessMessages;
 if not StopFind then begin
  if IncludeSubdirs then begin
   for i := 0 to DirList.Count - 1 do begin
     GetFiles(DirList[i], Mask, IncludeSubdirs, List);
       for ii := 0 to form1.lbFiles.Items.Count  do begin
        form1.StatusBar1.Panels[1].Text:='Files found: ' + IntToStr(ii);
        end;
    end;
  end;
 end;
finally
  DirList.Free;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
StopFind := true;
//form1.StatusBar1.Panels[1].Text:='';
//form1.StatusBar1.Panels[2].Text:='';
end;
0
Comment
Question by:Dark_King
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 14

Accepted Solution

by:
AvonWyss earned 300 total points
ID: 6243850
I'm not GeoBul, but try this:

procedure GetFiles(FromDir, Mask: String; IncludeSubdirs : boolean; List: TListBox);
var
DirInfo: TSearchRec;
R, ii, i: Integer;
DirList: TStringList;

begin

if FromDir[Length(FromDir)] <> '\' then FromDir := FromDir + '\';
DirList := TStringList.Create;
try
if not StopFind then begin
if IncludeSubdirs then begin
 R := FindFirst(FromDir + '*.*', faDirectory, DirInfo);
 if R = 0 then begin
  repeat
   if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then begin
     DirList.Add(FromDir + DirInfo.Name);

   end;
   R := FindNext(DirInfo);
  until R <> 0;
  FindClose(DirInfo);
 end;
end;
end;
R := FindFirst(FromDir + Mask, faAnyfile, DirInfo);
form1.StatusBar1.Panels[2].Text:=FromDir + DirInfo.Name + '\';
if R = 0 then begin
 repeat
     Application.ProcessMessages;
     if not StopFind then begin
   if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then begin
     if (((DirInfo.Attr and faDirectory) <> 0) and IncludeSubdirs) then GetFiles(FromDir + DirInfo.Name
+ '\', Mask, IncludeSubdirs, List)

       else List.Items.Add(FromDir + DirInfo.Name);
     end;
   end;
   R := FindNext(DirInfo);
 until R <> 0;
 FindClose(DirInfo);
end;
Application.ProcessMessages;
if not StopFind then begin
 if IncludeSubdirs then begin
  for i := 0 to DirList.Count - 1 do begin
    GetFiles(DirList[i], Mask, IncludeSubdirs, List);
      for ii := 0 to form1.lbFiles.Items.Count  do begin
       form1.StatusBar1.Panels[1].Text:='Files found: ' + IntToStr(ii);
       end;
   end;
 end;
end;
finally
 DirList.Free;
end;
end;
0
 
LVL 6

Author Comment

by:Dark_King
ID: 6246208
Hmm I miss that.
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…
In this video, Percona Solution Engineer Dimitri Vanoverbeke discusses why you want to use at least three nodes in a database cluster. To discuss how Percona Consulting can help with your design and architecture needs for your database and infras…
Suggested Courses

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question