Solved

To Geobul

Posted on 2001-07-01
2
154 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
2 Comments
 
LVL 14

Accepted Solution

by:
AvonWyss earned 100 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

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
This is used to tweak the memory usage for your computer, it is used for servers more so than workstations but just be careful editing registry settings as it may cause irreversible results. I hold no responsibility for anything you do to the regist…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, just open a new email message. In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…

813 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now