[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
?
Solved

Fix progressbar to follow the flow until finished

Posted on 2010-05-18
45
Medium Priority
?
1,361 Views
Last Modified: 2013-11-23
//This is one of I mentioned to you, that I will slowly build my own av, please help me to fix it.
//The code is running fine, BUT progressbar is not following the flow of the files outputed.


//Other experts could try fixing it.
//Thanks

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SyncObjs, ExtCtrls, ComCtrls;

type
  TListFilesWorkerThread = class(TThread)
   private
    FPath : String;
    FRecursive : Boolean;
    FFiles : TStringList;
    FFileFilters : TStringList;
    FLock : TMultiReadExclusiveWriteSynchronizer;
    FFinished : Boolean;
    FCurrentPath : String;
    FCurrentFile : String;
    FCurrentBar : Integer;

   protected
    Function GetFinished : Boolean;
    Function GetCurrentPath : String;
    Function GetCurrentFile : String;
    Function SetFunctionBar : Integer;

    Procedure SetFinished(Value : Boolean);
    Procedure SetCurrentPath(Value : String);
    Procedure GetPathFile(Value : String);
    Procedure SetProgressBar(Value : Integer);

    Procedure ListFiles(APath : String; AFileFilters : TStrings; AFiles : TStrings; ALock : TMultiReadExclusiveWriteSynchronizer; ARecursive : Boolean = True);

   public
    Constructor Create;
    Destructor Destroy; Override;
    Procedure Execute; Override;
    Property Files : TStringList read FFiles;
    Property FileFilters : TStringList read FFileFilters;
    Property Lock : TMultiReadExclusiveWriteSynchronizer read FLock;
    Property Recursive : Boolean read FRecursive write FRecursive;
    Property Path : String read FPath write FPath;
    Property Finished : Boolean read GetFinished;
    Property CurrentPath : String read GetCurrentPath;
    Property CurrentFile : String read GetCurrentFile;
    Property PropertyCurrentBar : Integer read SetFunctionBar;
  end;

  TForm1 = class(TForm)

    Timer1: TTimer;
    Label1: TLabel;
    Button1: TButton;
    ListBox1: TListBox;
    Memo1: TMemo;
    Edit1: TEdit;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;

    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
  private
    { Private declarations }
    AListFilesThread : TListFilesWorkerThread;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;

implementation

{$R *.dfm}

function CountTopFileDir(const dpath :string): integer;
var
search: TSearchRec;
counted:integer;
begin
counted:=0;
  if FindFirst(dpath + '\*.*', faAnyFile, search) = 0 then
  begin
    repeat
      //if ((search.Attr and faDirectory) <> faDirectory) then inc(counted);
      if ((search.Attr and faDirectory) = faDirectory) and (search.Name <> '.') and (search.Name <> '..')
      then inc(counted);
    until FindNext(search) <> 0;
    FindClose(search);
  end;
result := counted;
end;


{ TWorkerThread }
constructor TListFilesWorkerThread.Create;
begin
  inherited Create(True);
  FFiles := TStringList.Create;
  FFileFilters := TStringList.Create;
  FLock := TMultiReadExclusiveWriteSynchronizer.Create;
end;

destructor TListFilesWorkerThread.Destroy;
begin
  FLock.Free;
  FFileFilters.Free;
  FFiles.Free;
  inherited;
end;

function TListFilesWorkerThread.GetFinished: Boolean;
begin
  FLock.BeginRead;
  Result := FFinished;
  FLock.EndRead;
end;

procedure TListFilesWorkerThread.SetFinished(Value: Boolean);
begin
  FLock.BeginWrite;
  FFinished := Value;
  FLock.EndWrite;
end;

function TListFilesWorkerThread.GetCurrentPath: String;
begin
  FLock.BeginRead;
  Result := FCurrentPath;
  FLock.EndRead;
end;

function TListFilesWorkerThread.GetCurrentFile: String;
begin
  FLock.BeginRead;
  Result := FCurrentFile;
  FLock.EndRead;
end;

function TListFilesWorkerThread.SetFunctionBar: Integer;
begin
  FLock.BeginRead;
  Result := FCurrentBar;
  FLock.EndRead;
end;

procedure TListFilesWorkerThread.SetCurrentPath(Value: String);
begin
  FLock.BeginWrite;
  FCurrentPath := Value;
  FLock.EndWrite;
end;

procedure TListFilesWorkerThread.GetPathFile(Value: String);
begin
  FLock.BeginRead;
  FCurrentFile := Value;
  FLock.EndRead;
end;

procedure TListFilesWorkerThread.Setprogressbar(Value: integer);
begin
  FLock.BeginWrite;
  FCurrentBar := Value;
  FLock.EndWrite;
end;

procedure TListFilesWorkerThread.ListFiles(APath : String; AFileFilters : TStrings; AFiles : TStrings; ALock : TMultiReadExclusiveWriteSynchronizer; ARecursive : Boolean = True);
var i, aRes : Integer;
    aDirFiles : TStringList;
    aSearchRec : TSearchRec;
    ie: integer;
    counted: Integer;
Begin
counted := 0;
  SetCurrentPath(APath);
  aDirFiles := TStringList.Create;
  ALock.BeginRead;
    for i := 0 to AFileFilters.Count-1 do
    begin
      aRes := FindFirst(IncludeTrailingPathDelimiter(APath)+AFileFilters[i], faAnyFile-faVolumeID, aSearchRec);
        while aRes = 0 do
        begin
          if (aSearchRec.Attr <> faDirectory) then
          begin
           GetPathFile(APath + '\'+ aSearchRec.Name);
          end;
          aRes := FindNext(aSearchRec);
        end;
    end;

FindClose(aSearchRec);
ALock.EndRead;
aDirFiles.Free;

  if ARecursive and not Terminated then begin
    aRes := FindFirst(IncludeTrailingPathDelimiter(APath)+'*', faAnyFile, aSearchRec);
    try
      while aRes = 0 do begin
      if ((aSearchRec.Attr and faDirectory) = faDirectory) and (aSearchRec.Name <> '.') and (aSearchRec.Name <> '..')
      then begin
      inc(counted);
      SetProgressBar(counted);
      end;
        if ((aSearchRec.Attr and faDirectory) <> 0) and (aSearchRec.Name <> '.') and (aSearchRec.Name <> '..') then
          ListFiles(IncludeTrailingPathDelimiter(APath)+aSearchRec.Name, AFileFilters, AFiles, ALock, ARecursive);
        aRes := FindNext(aSearchRec);
      end;
    finally
      FindClose(aSearchRec);
    end;
  end;
end;

procedure TListFilesWorkerThread.Execute;
begin
  SetFinished(False);
  ListFiles(FPath, FFileFilters, FFiles, FLock, FRecursive);
  SetFinished(True);
end;


{ Form1 }
procedure TForm1.FormDestroy(Sender: TObject);
begin
//  AListFilesThread.Terminate;
//  AListFilesThread.WaitFor;
//  AListFilesThread.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  AListFilesThread.Lock.BeginRead;
  try
    Label1.Caption := AListFilesThread.CurrentFile;
    Progressbar1.Position := AlistFilesThread.PropertyCurrentBar;
    finally
    AListFilesThread.Lock.EndRead;
  end;

  if AListFilesThread.Finished then
  begin
    Timer1.Enabled := False;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var i : byte;
begin
progressbar1.Max := CountTopFileDir('c:');

  Timer1.Enabled := True;
  Timer1.Interval := 10;

  AListFilesThread := TListFilesWorkerThread.Create;
  AListFilesThread.Path := edit1.text;
  AListFilesThread.FRecursive := True;

  for i := 0 to (Listbox1.Items.Count-1) do
  begin
  AListFilesThread.FileFilters.Add(Listbox1.Items.Strings[i]);
  end;

  AListFilesThread.Resume;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
  ProgressBarStyle: integer;
begin
  SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_HIGHEST);
  SetThreadPriorityBoost(GetCurrentThread, false);

  StatusBar1.Panels[1].Style := psOwnerDraw;
  ProgressBar1.Parent := StatusBar1;
  ProgressBarStyle := GetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE);
  ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;
  SetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE, ProgressBarStyle);
Edit1.Text := 'c:\';
Listbox1.Items.add('*.exe');
Listbox1.Items.add('*.dll');
end;

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  if Panel = StatusBar.Panels[1] then
  with ProgressBar1 do begin
    Top := Rect.Top;
    Left := Rect.Left;
    Width := Rect.Right - Rect.Left - 15;
    Height := Rect.Bottom - Rect.Top;
  end;
end;

end.

Open in new window

0
Comment
Question by:systan
[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
  • 19
  • 15
  • 8
  • +1
45 Comments
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32787980
a comment
there is no try finally in your code

sample
procedure TListFilesWorkerThread.Setprogressbar(Value: integer);
begin
  FLock.BeginWrite;
  try
    FCurrentBar := Value;
    // you are not posting the value back to the form
    // you are missing code here
  finally
    FLock.EndWrite;
  end;
end;

check the article i wrote about updating a progressbar from within a thread
http://www.experts-exchange.com/articles/Programming/Languages/Pascal/Delphi/Displaying-progress-in-the-main-form-from-a-thread-in-Delphi.html
0
 
LVL 25

Expert Comment

by:epasquier
ID: 32788120
That is a bit complicated. You first make a count of files to treat with one method (CountTopFileDir), then you re-scan your search path to treat the files.
I recommend using this procedure to first list all your files, set the Max property of the progressbar, all of it when the thread is started, then each time you treat a file you change the progressbar position.

If you really wanted to, you could use this function to first find all directories, set the progressbar to the number of dir you find, and then scan for files in those directory : therefore you'll have 2 tasks tracked by the pbar : first the discovery of all files in the directory (pbar position updated each time a new folder is scanned) and after, the real treatment of files.

To list all sub-directories :
 FindFiles('D:\Delphi','*.*',listBox.Items,faDirectory,faDirectory,[soRecurse,soFullName]);

to list all files :
 FindFiles('D:\Delphi','*.Pas',listBox.Items,faAnyFile-faDirectory,0,[soRecurse,soFullName]);

beware that if you don't include [soClearList] in options, the Res list will not be cleared and anything found will be added to the existing list. You have then to clear it yourself when you need.

Type
 TSearchOption=(soRecurse,soFullName,soClearList,soResIncludeDir,soDates);
 TSearchOptions=Set of TSearchOption;
 TFileDates=class(TObject)
 public
  CreateDT, AccessDT, ModifyDT: TDateTime;
  Size:Cardinal;
 end;

procedure FindFiles(Dir,Search:String;Res:TStrings;OrAttr:Integer=faAnyFile;AndAttr:Integer=0;Options:TSearchOptions=[];SubDir:STring='';FixedSubDir:String='';Level:integer=0);
Var
 R:TSearchRec;
 S:String;
 R2:TStringList;
 FileDates:TFileDates;
 i:integer;
begin
 Dir:=IncludeTrailingBackslash(Dir);
 OrAttr:=OrAttr Or AndAttr;
 if SubDir<>'' Then SubDir:=IncludeTrailingBackSlash(SubDir);
 if FixedSubDir<>'' Then FixedSubDir:=IncludeTrailingBackSlash(FixedSubDir);
 if soClearList IN Options Then
  begin
   for i:=0 to Res.Count-1 do try Res.Objects[i].Free except end;
   Res.Clear;
   Options:=Options-[soClearList];
  end;
 if FindFirst(Dir+SubDir+FixedSubDir+Search,OrAttr,R)=0 then
  repeat
   if ((R.Attr And AndAttr)=AndAttr) And (R.Name[1]<>'.') Then
    begin
     S:=UpperCase(SubDir+FixedSubDir+R.Name);
     if soFullName IN Options Then Res.Add(Dir+S) Else Res.Add(S);
     if soDates IN Options Then
      begin
       FileDates:=TFileDates.Create;
       With FileDates do
        begin
         CreateDT := FileTimeToDTime(R.FindData.ftCreationTime);
         AccessDT := FileTimeToDTime(R.FindData.ftLastAccessTime);;
         ModifyDT := FileTimeToDTime(R.FindData.ftLastWriteTime);;
         Size:=R.Size;
        end;
       Res.Objects[Res.Count-1]:=FileDates;
      end;
    end;
  until FindNext(R)<>0;
 if (soRecurse IN Options) And (FindFirst(Dir+SubDir+FixedSubDir+'*.*',faDirectory,R)=0) then
  repeat
   if ((R.Attr And faDirectory)>0) And (R.Name[1]<>'.') Then
    begin
     R2:=TStringList.Create;
     FindFiles(Dir,Search,R2,OrAttr,AndAttr,Options,SubDir+R.Name,FixedSubDir,Level+1);
     if R2.Count>0 Then
      begin
       if (soResIncludeDir IN Options) Then Res.Add(Format('*%d*',[Level+1])+SubDir+FixedSubDir+R.Name);
       Res.AddStrings(R2);
      end;
     R2.Free; 
    end;
  until FindNext(R)<>0;
end;

Open in new window

0
 
LVL 25

Expert Comment

by:epasquier
ID: 32788184
Ah, yes, I was about to link to Geert article on progressbar so that you change this part according his recommendations. With that and my global search procedure, you should be able to redesign your search thread easily.

I recommend also setting first the search path (only the directories), and second a list of search filters (just *.exe , *.dll )

Without going into details about how to set the PB max & position (see Geert article for real method), your Execute should look like this :
procedure TListFilesWorkerThread.Execute;
Var
 i,j:integer;
 SubDir:TStringList;
begin
 SetFinished(False);
 SubDir:=TStringList.Create;
 // Status on progress form = 'Listing directories...'
 for i:=0 to FFilePath.Count-1 do 
  FindFiles(FFilePath[i],'*.*',SubDir,faDirectory,faDirectory,[soRecurse,soFullName]);
 
 FFiles.Clear;
 // Status on progress form = 'Listing Files...'
 ProgressBar.Max:=SubDir.Count*FFileFilters.Count;
 ProgressBar.Position:=0;
 for i:=0 to SubDir.Count-1 do for j:=0 to FFileFilters.Count-1 do
  begin
   ProgressBar.Position:=ProgressBar.Position+1;
   FindFiles(SubDir[i],FFileFilters[j],FFiles,faAnyFile-faDirectory,0,[soFullName]);
  end; 
 SubDir.Free;

 // Status on progress form = 'Scanning Files...'
 ProgressBar.Max:=FFiles.Count;
 ProgressBar.Position:=0;
 for i:=0 to FFiles.Count-1 do
  begin
   ProgressBar.Position:=ProgressBar.Position+1;
   VirusScanFile(FFiles[i]);
  end;

 SetFinished(True);
end;

Open in new window

0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 14

Author Comment

by:systan
ID: 32788215
>>there is no try finally in your code
YES, I temporarily remove it for some reasons. I'll put it in finals.

>>check the article i wrote about updating a progressbar from within a thread
YES, the progressbar you wrote is good, but it only flows with the number you've assigned.
Can you mixed it with my code while scanning fiels


>>That is a bit complicated
Actually its not complecated, first I count the number of folders inside the mask[c:\], and assigned it for
progressbar.max = number of folders inside the assigned mask

I did do that for fast reason in getting count of top folders rather than count of all files.

I don't know if your scanning code is faster than my code from hypo's answered link, I'll try to test which is faster.   I'll test later when i got the progressbar fix so I can apply it to your given code also.

About the progressbar.value, the problem is how can I get the count of folders that is currently scanned for my
progressbar.value = number of currently scanned folder

eq:
c:\windows
c:\programfiles
c:\documentandsetings
c:\somefolders1
c:\somefolders2

if c:\ has 5 folders then progressbar.max = 5;
while scanning in on progress
c:\windows - finished
c:\progressbar - finished
c:\documentandsettings
progressbar.value = 3

until it reach 5, so progressbar.value is exactly finished, thats the main idea,
So, can both of you add some code to finally resolve the problem?

Thanks
0
 
LVL 14

Author Comment

by:systan
ID: 32788228
Oh, additional comment by epasquier, sorry I was not able to read first while submitting my comment, iLL be back, I got to go. I'll read after I come back. asap.
0
 
LVL 14

Author Comment

by:systan
ID: 32788235
Ok, I've read it, I'll be back, asap, someone is calling.
Thank you
0
 
LVL 25

Expert Comment

by:epasquier
ID: 32788277
> Actually its not complecated, first I count the number of folders inside the mask[c:\],
> and assigned it for progressbar.max = number of folders inside the assigned mask
Yes it is, because you don't use a global function, and it's always difficult to look into all possible implementations of FindFirst/FindNext to see what result should that give. Which is why eventually I got bored with doing it all the time and made this FindFiles procedure with high-level options.
I grant you that even I must look into the implementation from time to time to remember which parameter set I must use to get a particular result, but now I use only this same procedure for all projects where I need to find dir or files. It can even in option get the file dates (creation...) in the same loop, but I won't go into this now.

> I did do that for fast reason in getting count of top folders rather than count of all files.
Yep I got that. Probably you did not get the second post before answering

> I don't know if your scanning code is faster than my code from hypo's answered link, I'll try to test
> which is faster.  
They are both relying on the same FindFirst/FindNext SLOW method which are limited by Hard Drive and system file performance, so there should be not much difference. But I think that the way I sliced the use of my FindFiles into 2 parts, one for finding sub dir, and another double loop to find all files, is effective.

> About the progressbar.value, the problem is how can I get the count of folders that is currently
> scanned for my progressbar.value = number of currently scanned folder
that is answered also
0
 
LVL 14

Author Comment

by:systan
ID: 32790702
Ok, I'm back, I've read it.
I have to test the code first
I'll comment some when I come back later

Thanks again
0
 
LVL 14

Author Comment

by:systan
ID: 32792024
I'm finding the <FileTimeToDTime>, and links lead me to your answered link
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_24814003.html

But, I'll try to remove the <FileTimeToDTime>, it does not belong to my application, Ok, I'll comment later again, I'm trying to do a test.
0
 
LVL 14

Author Comment

by:systan
ID: 32792253
Ok, I mixed your code with mine
I remove <FileTimeToDTime>, no errors  at that time

Now., FFilePath is undeclared, so I declared it as  a TStringList;
Var
 i,j:integer;
 SubDir:TStringList;
//<>
 FFilePath:TStringList;
//<>
begin
 SetFinished(False);
 SubDir:=TStringList.Create;

//<>
 FFilePath:=TStringList.Create;
 FFilePath.Add('c:\');
 FFilePath.Add('d:\');
//<>

 // Status on progress form = 'Listing directories...'
 for i:=0 to FFilePath.Count-1 do
  FindFiles(FFilePath[i],'*.*',SubDir,faDirectory,faDirectory,[soRecurse,soFullName]);

 FFiles.Clear;

 // Status on progress form = 'Listing Files...'
 Form1.Progressbar1.Max:=SubDir.Count*FFileFilters.Count;
//ADDED Form1.Progressbar1
...
...
Run the code, nothings happen


Epasquier can you send a full code, I know 5minutes is a long time for you change it.
Please,
Its a less time consuming when tested code from you.
And with your full code, I can test directly which is one to use in scanning files.
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32792676
actually it should be easy to implement epasquier's sample in my code
i'll give it a shot ...
0
 
LVL 25

Expert Comment

by:epasquier
ID: 32793478
sorry, I forgot this part.

Commenting out is a good solution also as you don't use that
function FileTimeToDTime(FTime: TFileTime): TDateTime;
var
  LocalFTime: TFileTime;
  STime: TSystemTime;
begin
  FileTimeToLocalFileTime(FTime, LocalFTime);
  FileTimeToSystemTime(LocalFTime, STime);
  Result := SystemTimeToDateTime(STime);
end;

Open in new window

0
 
LVL 14

Author Comment

by:systan
ID: 32793606
>>actually it should be easy to implement epasquier's sample in my code
yes its easy because your an expert too, me? still have to eat more rice to rock delphi.

i'll give it a shot ...
Ok, I'll wait for that shot, next comment will be yours, lol    



Epasquier
Even with that function, the code you gave doesn't manage to scan
Can you just put your complete code here,  from unit1 to end.
Please..., lets make this post end fast, except for Geert is trying to achive your code? or mine.
I hope his got some good ideas.

Ok
Thanks
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32793897
an expert ? ugh not a genius yet ... :)

i'll have a look on my harddrive for some code
it should be there somewhere

a sample with a system to read a directory within a thread
and a progressbar on a form ?

oooo ... you're in luck, i just created a new system:
what it does is look for sqlite files and scan them within the thread
same as what you need ...

and more ...
i created a small engine too, to start threads in parallel
this may be a little too much for what you need, but then again ... maybe not :)

here is the engine to start with

unit uQueuedThreads;

interface

uses Classes, Contnrs;

const
  MaxRunningThreads: integer = 5;
  THREADSLEEP      : integer = 1000;

type
  TStringsClass = class of TStrings;

  TQueuedThread = class;
  TQueuedThreadClass = class of TQueuedThread;
  TQuedThreadReturnInfo = procedure (Sender: TObject; Info: TStrings) of object;

  TThreadQueueData = class(TObject)
  private
    FInfo: TStrings;
    FThreadClass: TQueuedThreadClass;
    FReturnInfo: TQuedThreadReturnInfo;
  protected
    function InfoClass: TStringsClass; virtual;
    function GetInfo: TStrings; virtual;
    procedure SetInfo(const Value: TStrings); virtual;
  public
    constructor Create(aInfo: TStrings; aThreadClass: TQueuedThreadClass; aReturnInfo: TQuedThreadReturnInfo = nil); virtual;
    destructor Destroy; override;

    property Info: TStrings read GetInfo write SetInfo;
    property ThreadClass: TQueuedThreadClass read fThreadClass;
  end;

  TThreadQueue = class(TQueue)
  public
    procedure Add(aInfo: TStrings; aThreadClass: TQueuedThreadClass; aReturnInfo: TQuedThreadReturnInfo = nil);
  end;

  TThreadEmptyQueue = class(TThread)
  private
    fThreadList: TThreadList;
  protected
    procedure Execute; override;
    procedure ThreadDone(Sender: TObject);
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
  end;

  TQueuedThread = class(TThread)
  private
    fInfo: TThreadQueueData;
    fReturnInfoMsg: TStrings;
    fReturnInfo: TQuedThreadReturnInfo;
    function GetInfo: TStrings;
  protected
    procedure Execute; override;
    procedure DoReturnInfo;
    procedure AddReturnInfo(Name, Value: string; Send: Boolean = True);
    procedure SendReturnInfo;
    property Info: TStrings read GetInfo;
    property ReturnInfo: TQuedThreadReturnInfo read fReturnInfo write fReturnInfo;
  public
    constructor Create(aInfo: TThreadQueueData; aOnThreadDone: TNotifyEvent); reintroduce;
    destructor Destroy; override;
  end;

procedure AddQueueItem(Info: TStrings; ThreadClass: TQueuedThreadClass; aReturnInfo: TQuedThreadReturnInfo = nil);

function ProcessingQueue: Boolean;

implementation

uses SyncObjs, SysUtils;

var
  mThreadQueue: TThreadQueue;
  mCSThreadQueue: TCriticalSection;
  mThreadEmptyQueue: TThreadEmptyQueue;

function ProcessingQueue: Boolean;
begin
  Result := Assigned(mThreadEmptyQueue);
end;

function ThreadQueue: TThreadQueue;
begin
  if not Assigned(mThreadQueue) then
    mThreadQueue := TThreadQueue.Create;
  Result := mThreadQueue;
end;

procedure StartThreadEmptyQueue;
begin
  if not Assigned(mThreadEmptyQueue) then
    mThreadEmptyQueue := TThreadEmptyQueue.Create;
end;

procedure AddQueueItem(Info: TStrings; ThreadClass: TQueuedThreadClass; aReturnInfo: TQuedThreadReturnInfo = nil);
begin
  ThreadQueue.Add(Info, ThreadClass, aReturnInfo);
end;

{ TThreadQueue }

procedure TThreadQueue.Add(aInfo: TStrings; aThreadClass: TQueuedThreadClass; aReturnInfo: TQuedThreadReturnInfo = nil);
begin
  mCSThreadQueue.Enter;
  try
    PushItem(TThreadQueueData.Create(aInfo, aThreadClass, aReturnInfo));
  finally
    mCSThreadQueue.Leave;
  end;
  StartThreadEmptyQueue;
end;

{ TThreadEmptyQueue }

constructor TThreadEmptyQueue.Create;
begin
  inherited Create(False);
  FreeOnTerminate := True;
  fThreadList := TThreadList.Create;
end;

destructor TThreadEmptyQueue.Destroy;
begin
  FreeAndNil(fThreadList);
  inherited Destroy;
end;

procedure TThreadEmptyQueue.Execute;
var data: TThreadQueueData;
begin
  while not Terminated do
  begin
    with fThreadList.LockList do
    try
      if (Count < MaxRunningThreads) and ThreadQueue.AtLeast(1) then
      begin
        data := TThreadQueueData(ThreadQueue.PopItem);
        if Assigned(data) then
          fThreadList.Add(data.ThreadClass.Create(data, ThreadDone));
      end;
    finally
      fThreadList.UnlockList;
    end;
    Sleep(THREADSLEEP);
  end;
end;

procedure TThreadEmptyQueue.ThreadDone(Sender: TObject);
var Stop: Boolean;
begin
  Stop := False;
  with fThreadList.LockList do
  try
    Delete(IndexOf(Sender));
    if Count = 0 then
      Stop := True;
  finally
    fThreadList.UnlockList;
  end;
  if Stop then
  begin
    Terminate;
    mThreadEmptyQueue := nil;
  end;
end;

{ TQueuedThread }

procedure TQueuedThread.AddReturnInfo(Name, Value: string; Send: Boolean);
begin
  fReturnInfoMsg.Add(Format('%s=%s', [Name, Value]));
  if Send then
    SendReturnInfo;
end;

constructor TQueuedThread.Create(aInfo: TThreadQueueData; aOnThreadDone: TNotifyEvent);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  OnTerminate := aOnThreadDone;
  fReturnInfoMsg := TStringList.Create;
  fInfo := aInfo;
  fReturnInfo := nil;
  if Assigned(aInfo) then
    fReturnInfo := aInfo.FReturnInfo;

end;

destructor TQueuedThread.Destroy;
begin
  FreeAndNil(fInfo);
  FreeAndNil(fReturnInfoMsg);
  inherited Destroy;
end;

procedure TQueuedThread.DoReturnInfo;
begin
  if Assigned(fReturnInfo) then
    fReturnInfo(Self, fReturnInfoMsg);
end;

procedure TQueuedThread.Execute;
begin
  inherited;
  Sleep(5000);
end;

function TQueuedThread.GetInfo: TStrings;
begin
  Result := fInfo.Info;
end;

procedure TQueuedThread.SendReturnInfo;
begin
  Synchronize(DoReturnInfo);
  fReturnInfoMsg.Clear;
end;

procedure UnitInit;
begin
  mCSThreadQueue := TCriticalSection.Create;
end;

procedure UnitDone;
begin
  FreeAndNil(mThreadQueue);
  FreeAndNil(mCSThreadQueue);
end;

{ TThreadQueueData }

constructor TThreadQueueData.Create(aInfo: TStrings; aThreadClass: TQueuedThreadClass; aReturnInfo: TQuedThreadReturnInfo = nil);
begin
  inherited Create;
  fInfo := InfoClass.Create;
  if Assigned(aInfo) then
    fInfo.Assign(aInfo);
  fThreadClass := aThreadClass;
  fReturnInfo := aReturnInfo;
end;

destructor TThreadQueueData.Destroy;
begin
  FreeAndNil(fInfo);
  inherited Destroy;
end;

function TThreadQueueData.GetInfo: TStrings;
begin
  Result := fInfo;
end;

function TThreadQueueData.InfoClass: TStringsClass;
begin
  Result := TStringList;
end;

procedure TThreadQueueData.SetInfo(const Value: TStrings);
begin
  fInfo.BeginUpdate;
  try
    fInfo.Clear;
    if Assigned(Value) then
      fInfo.Assign(Value);
  finally
    fInfo.EndUpdate;
  end;
end;

initialization
  UnitInit;
finalization
  UnitDone;
end.

Open in new window

0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32794078
now lets look how to use that engine

we need to derive a new class from TQueuedThread
this is the thread that does the actual work
the rest is just part of the managing of the threads

oopsy doopsy ... possible bug in the code (a attribute can consist of more than 1 value):
change this
  if (aSearchRec.Attr  <> faDirectory) then
into
  if (aSearchRec.Attr and faDirectory) <> faDirectory then

hey ... i'm trying to use your sample in the header
but... it's not correct ... have you actually got this working ?
i'm not going to spend more time on trying to implement something like that.

what is the point of this piece of code anyway ?
aDirFiles := TStringList.Create;
  try
    //ALock.BeginRead;
    for i := 0 to AFileFilters.Count-1 do
    begin
      aRes := FindFirst(IncludeTrailingPathDelimiter(APath) + AFileFilters[i], faAnyFile - faVolumeID, aSearchRec);
      try
        while aRes = 0 do
        begin
          if (aSearchRec.Attr and faDirectory) <> faDirectory then
            GetPathFile(APath + '\'+ aSearchRec.Name);
          aRes := FindNext(aSearchRec);
        end;
      finally
        FindClose(aSearchRec);
      end;
    end;

you only set a private variable ... and don't do anything with it ...
what are you trying to accomplish ?
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32794095
>>aikimark
Is this a follow-up question?
a little obvious if you ask me ... :)

i believe systan has found the "private mail" feature
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32794132
let me use my code for listing files in a directory
and return the number to the memo

the next step is cutting up that list of files
and reading some data from every file in a other thread (or multiple)
and also adding that info to a second memo
0
 
LVL 14

Author Comment

by:systan
ID: 32794230
A, Ok,
Thanks
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32794247
aikimark ... additional ? maybe wait until finished ?

here is code which counts and lists the number of files in C:\Temp\
using the previous engine
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, uQueuedThreads;

type
  TForm1 = class(TForm)
    edDir: TEdit;
    btnScanDir: TButton;
    lblDir: TLabel;
    memFileList: TMemo;
    procedure btnScanDirClick(Sender: TObject);
  private
    procedure AddScanFolder(Directory, Spec: string; aReturnInfo: TQuedThreadReturnInfo = nil);
    procedure ReturnInfo(Sender: TObject; Info: TStrings);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TListFilesWorkerThread = class(TQueuedThread)
  private
    procedure ListDirs(dir: string; List: TStrings);
    procedure ListFiles(dir, spec: string; List: TStrings);
    procedure ListFilesInDir(dir, spec: string; List: TStrings);
  protected
    procedure Execute; override;
  end;

procedure TListFilesWorkerThread.ListFilesInDir(dir, spec: string; List: TStrings);
var sr: TSearchRec;
  procedure CheckFile;
  begin
    if (sr.Name <> '.') and (sr.Name <> '..') then
      List.Add(dir + sr.Name);
  end;
begin
  if FindFirst(dir + spec, faAnyFile, sr) = 0 then
  try
    CheckFile;
    while FindNext(sr) = 0 do CheckFile;
  finally
    FindClose(sr);
  end;
end;

procedure TListFilesWorkerThread.ListDirs(dir: string; List: TStrings);
var sr: TSearchRec;
  procedure CheckDir;
  begin
    if (sr.Name <> '.') and (sr.Name <> '..') and (sr.Attr and faDirectory = faDirectory) then
    begin
      List.Add(dir + sr.Name + '\');
      ListDirs(dir + sr.Name + '\', List);
    end;
  end;
begin
  if FindFirst(dir + '*.*', faDirectory, sr) = 0 then
  try
    CheckDir;
    while FindNext(sr) = 0 do CheckDir;
  finally
    FindClose(sr);
  end;
end;

procedure TListFilesWorkerThread.ListFiles(dir, spec: string; List: TStrings);
var
  dirs: TStrings;
  I: Integer;
begin
  dirs := TStringList.Create;
  try
    dirs.Add(dir);
    ListDirs(dir, dirs);
    for I := 0 to dirs.Count - 1 do
      ListFilesInDir(dirs[I], spec, List);
  finally
    dirs.Free;
  end;
end;

procedure TListFilesWorkerThread.Execute;
var Directory, Spec: string;
  List: TStringList;
  I: Integer;
begin
  Directory := Info.Values['DIRECTORY'];
  Spec := Info.Values['SPEC'];
  List := TStringList.Create;
  try
    ListFiles(Directory, Spec, List);
    AddReturnInfo('NUMBER_OF_FILES', IntToStr(List.Count));
    AddReturnInfo('FILES', ' '#13#10+List.Text);
  finally
    List.Free;
  end;
end;

procedure TForm1.AddScanFolder(Directory, Spec: string; aReturnInfo: TQuedThreadReturnInfo = nil);
var Info: TStrings;
begin
  Info := TStringList.Create;
  try
    Info.Values['DIRECTORY'] := Directory;
    Info.Values['SPEC'] := Spec;
    AddQueueItem(Info, TListFilesWorkerThread, aReturnInfo);
  finally
    Info.Free;
  end;
end;

procedure TForm1.btnScanDirClick(Sender: TObject);
begin
  AddScanFolder('C:\TEMP\', '*.*', ReturnInfo);
end;

procedure TForm1.ReturnInfo(Sender: TObject; Info: TStrings);
const
  MaxLines = 500;
  Delta = 50;
begin
  memFileList.Lines.BeginUpdate;
  try
    if memFileList.Lines.Count > MaxLines then
      while memFileList.Lines.Count > MaxLines - Delta do
        memFileList.Lines.Delete(0);
    memFileList.Lines.AddStrings(Info);
  finally
    memFileList.Lines.EndUpdate;
  end;
  memFileList.SelStart := Length(memFileList.Text);
  memFileList.SelLength := 0;
end;

end.

Open in new window

0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32794263
and now, for the piece the resistance,
cut up the files found into smaller pieces
and get the file date for each file within a thread
and return that info to the new memo
0
 
LVL 14

Author Comment

by:systan
ID: 32794457
aikimark
>>Is this a follow-up question?
No, its not, but a link of the discussion that we previously talk abouts.

>>Is there any additional information I should add to this question text for the benefit of future readers?
Nothing serious, just achiving a personal task

Geert
>>what is the point of this piece of code anyway ?
A Step for implementing a personal AV[scanning files first], and this is file scanning code I selected because it scans so fast, I've tested some but they are slow.   But I've like to try Epasquier scan engine code if there will be no bugs upon my testing,   just like your code, I'd like to try it.

>>what are you trying to accomplish ?
I am tring to accomplish a file scanner with a progreess bar
The complete Code I shown above is running fine, but the progressbar is not functioning well


>>here is the engine to start with
OH, I'm very sorry, I'm not an expert as you are guys
Geert, can you please make another unit or unit1 with buttons and labels, I dont know how to implement your < unit uQueuedThreads; >

Epasquier,
Do you have your complite simple code? in scanning files with progressbar?  I dont need to read the files, just scan with progressbar....reading the files will be the next step for other question to post.


The last comment I see is mine.,
A, Ok
Thanks

i'll click submit now
0
 
LVL 14

Author Comment

by:systan
ID: 32794577
>>here is code which counts and lists the number of files in C:\Temp\
using the previous engine

Ok, I'll try it

Thanks
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32794704
oh, one other thing
  SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_HIGHEST);
  SetThreadPriorityBoost(GetCurrentThread, false);

if i ever encounter a anti-virus with this
the next thing is uninstall !

it should use a little as possible resources !!!
0
 
LVL 14

Author Comment

by:systan
ID: 32794754
Geert
Why its so fast?
SUPERFAST, But delays on first time, and where is the <<progressbar>>?
and also, it only scans 1 mask

But I applied 2 mask
  AddScanFolder('C:\', '*.exe', ReturnInfo);
  AddScanFolder('C:\', '*.dll', ReturnInfo);

iS that if you want to scan 2 mask?


Epasquier where are you?  can't you comment?
0
 
LVL 14

Author Comment

by:systan
ID: 32794784
>>if i ever encounter a anti-virus with this
the next thing is uninstall !
lol
But its only my personal AV,
and its a step 1,
next is reading signatures(this is hard),
but I'll not post a question on that.

Ok, Listening to my second last comment question
0
 
LVL 25

Expert Comment

by:epasquier
ID: 32794790
I've extracted the FindFiles procedure and needed stuff , I think you had all needed.

here is a complete form code, there is just one listbox with align=alClient . Create a new project with that and copy the implementation that follows

It works fine for me (it listed all sub-dir and .pas files in my entire \Delphi root
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    lst1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

Type
 TSearchOption=(soRecurse,soFullName,soClearList,soResIncludeDir,soDates);
 TSearchOptions=Set of TSearchOption;
 TFileDates=class(TObject)
 public
  CreateDT, AccessDT, ModifyDT: TDateTime;
  Size:Cardinal;
 end;

function FileTimeToDTime(FTime: TFileTime): TDateTime;
var
  LocalFTime: TFileTime;
  STime: TSystemTime;
begin
  FileTimeToLocalFileTime(FTime, LocalFTime);
  FileTimeToSystemTime(LocalFTime, STime);
  Result := SystemTimeToDateTime(STime);
end;

procedure FindFiles(Dir,Search:String;Res:TStrings;OrAttr:Integer=faAnyFile;AndAttr:Integer=0;Options:TSearchOptions=[];SubDir:STring='';FixedSubDir:String='';Level:integer=0);
Var
 R:TSearchRec;
 S:String;
 R2:TStringList;
 FileDates:TFileDates;
 i:integer;
begin
 Dir:=IncludeTrailingBackslash(Dir);
 OrAttr:=OrAttr Or AndAttr;
 if SubDir<>'' Then SubDir:=IncludeTrailingBackSlash(SubDir);
 if FixedSubDir<>'' Then FixedSubDir:=IncludeTrailingBackSlash(FixedSubDir);
 if soClearList IN Options Then
  begin
   for i:=0 to Res.Count-1 do try Res.Objects[i].Free except end;
   Res.Clear;
   Options:=Options-[soClearList];
  end;
// if soRecurse IN Options Then OrAttr:=OrAttr Or faDirectory;
 if FindFirst(Dir+SubDir+FixedSubDir+Search,OrAttr,R)=0 then
  repeat
   if ((R.Attr And AndAttr)=AndAttr) And (R.Name[1]<>'.') Then
    begin
     S:=SubDir+FixedSubDir+R.Name;
//     S:=UpperCase(S);
     if soFullName IN Options Then Res.Add(Dir+S) Else Res.Add(S);
     if soDates IN Options Then
      begin
       FileDates:=TFileDates.Create;
       With FileDates do
        begin
         CreateDT := FileTimeToDTime(R.FindData.ftCreationTime);
         AccessDT := FileTimeToDTime(R.FindData.ftLastAccessTime);;
         ModifyDT := FileTimeToDTime(R.FindData.ftLastWriteTime);;
         Size:=R.Size;
        end;
       Res.Objects[Res.Count-1]:=FileDates;
      end;
    end;
  until FindNext(R)<>0;
 if (soRecurse IN Options) And (FindFirst(Dir+SubDir+FixedSubDir+'*.*',faDirectory,R)=0) then
  repeat
   if ((R.Attr And faDirectory)>0) And (R.Name[1]<>'.') Then
    begin
     R2:=TStringList.Create;
     FindFiles(Dir,Search,R2,OrAttr,AndAttr,Options,SubDir+R.Name,FixedSubDir,Level+1);
     if R2.Count>0 Then
      begin
       if (soResIncludeDir IN Options) Then Res.Add(Format('*%d*',[Level+1])+SubDir+FixedSubDir+R.Name);
       Res.AddStrings(R2);
      end;
     R2.Free;
    end;
  until FindNext(R)<>0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FindFiles('D:\Delphi','*.*',lst1.Items,faDirectory,faDirectory,[soRecurse,soFullName]);
 FindFiles('D:\Delphi','*.Pas',lst1.Items,faAnyFile-faDirectory,0,[soRecurse,soFullName]);
end;

end.

Open in new window

0
 
LVL 25

Expert Comment

by:epasquier
ID: 32794845
Systan, I'm sorry for being a bit unavailable today, and tomorrow morning as well.
The FindFiles part posted above is working smoothly. I know that is only the first stone. The second one is to take a closer look at Geert article, I have not re-read it yet, but I'm remembering that it is the second stone. And with the last stone being the Execute sample I already posted.
It wont compile just like that, it needs some twisting to glue all parts together, but I'm pretty sure the net solution will be clean and efficient.

I can do it tomorrow afternoon if geert do not finish it by then.
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32794870
omg, i found a bug in my own code
in the engine ... :(
trying to locate and fix it
0
 
LVL 38

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 800 total points
ID: 32794882
the solution is to leave the thread running which will empty the job queue
not very neat :(

procedure TThreadEmptyQueue.ThreadDone(Sender: TObject);
var Stop: Boolean;
begin
  Stop := False;
  with fThreadList.LockList do
  try
    Delete(IndexOf(Sender));
    if Count = 0 then
      Stop := True;
  finally
    fThreadList.UnlockList;
  end;
  //if Stop then
  //begin
  //  Terminate;
  //  mThreadEmptyQueue := nil;
  //end;
end;
0
 
LVL 14

Author Comment

by:systan
ID: 32794890
The codes are great, super fast,  but where is the progressbar1 during scanning?
Your both good, excellent, but where is the progressbar1 inserted to your codes?

My code is even slower, but  there is a progressbar1 and I don't understand that you keep buggling thereis a bug on my code, while "GURO hypo contributed that code"  and I hope hypo is here also

Anyway, I have to sleep, its 6:10am
I'll comment again 4hours from now.


Thank you for both of you
If points can be made 4000, I will do that, great experts!
see_yah
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32795255
that's odd, my last post is missing
ah yeah, ee was down :(
here it is again

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, uQueuedThreads, ComCtrls;

type
  TForm1 = class(TForm)
    edDir: TEdit;
    btnScanDir: TButton;
    lblDir: TLabel;
    memFileList: TMemo;
    ProgressBar1: TProgressBar;
    procedure btnScanDirClick(Sender: TObject);
  private
    procedure AddScanFolder(Directory, Spec: string; aReturnInfo: TQuedThreadReturnInfo = nil);
    procedure ReturnInfo(Sender: TObject; Info: TStrings);
    procedure AddScanJob(List: TStrings);
    procedure AddMemoInfo(aMemo: TMemo; Info: TStrings);
    procedure ReturnInfoScan(Sender: TObject; Info: TStrings);
    procedure SetProgress(aNum: integer; aNumType: integer = 0);
    procedure AddProgress(aNum: Integer);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TListFilesWorkerThread = class(TQueuedThread)
  private
    procedure ListDirs(dir: string; List: TStrings);
    procedure ListFiles(dir, spec: string; List: TStrings);
    procedure ListFilesInDir(dir, spec: string; List: TStrings);
  protected
    procedure Execute; override;
  end;

  TScanFileItems = class(TQueuedThread)
  private
    procedure Execute; override;
  end;

procedure TListFilesWorkerThread.ListFilesInDir(dir, spec: string; List: TStrings);
var sr: TSearchRec;
  procedure CheckFile;
  begin
    if (sr.Name <> '.') and (sr.Name <> '..') then
      List.Add(dir + sr.Name);
  end;
begin
  if FindFirst(dir + spec, faAnyFile, sr) = 0 then
  try
    CheckFile;
    while FindNext(sr) = 0 do CheckFile;
  finally
    FindClose(sr);
  end;
end;

procedure TListFilesWorkerThread.ListDirs(dir: string; List: TStrings);
var sr: TSearchRec;
  procedure CheckDir;
  begin
    if (sr.Name <> '.') and (sr.Name <> '..') and (sr.Attr and faDirectory = faDirectory) then
    begin
      List.Add(dir + sr.Name + '\');
      ListDirs(dir + sr.Name + '\', List);
    end;
  end;
begin
  if FindFirst(dir + '*.*', faDirectory, sr) = 0 then
  try
    CheckDir;
    while FindNext(sr) = 0 do CheckDir;
  finally
    FindClose(sr);
  end;
end;

procedure TListFilesWorkerThread.ListFiles(dir, spec: string; List: TStrings);
var
  dirs: TStrings;
  I: Integer;
begin
  dirs := TStringList.Create;
  try
    dirs.Add(dir);
    ListDirs(dir, dirs);
    for I := 0 to dirs.Count - 1 do
      ListFilesInDir(dirs[I], spec, List);
  finally
    dirs.Free;
  end;
end;

procedure TListFilesWorkerThread.Execute;
var Directory, Spec: string;
  List: TStringList;
  I: Integer;
begin
  Directory := Info.Values['DIRECTORY'];
  Spec := Info.Values['SPEC'];
  List := TStringList.Create;
  try
    ListFiles(Directory, Spec, List);
    AddReturnInfo('NUMBER_OF_FILES', IntToStr(List.Count));
    AddReturnInfo('FILES', ' '#13#10+List.Text);
  finally
    List.Free;
  end;
end;

{ TScanFileItems }

procedure TScanFileItems.Execute;
var I: Integer;
begin
  AddReturnInfo('Files to scan', IntToStr(Info.Count), False);
  for I := 0 to Info.Count - 1 do
    Info[I] :=  FormatDateTime('yyyymmddhhnnss', FileDateToDateTime(FileAge(Info.Strings[I]))) + ' --- ' + Info[I];
  AddReturnInfo('FILEDATES', Info.Text);
end;

procedure TForm1.AddScanFolder(Directory, Spec: string; aReturnInfo: TQuedThreadReturnInfo = nil);
var Info: TStrings;
begin
  Info := TStringList.Create;
  try
    Info.Values['DIRECTORY'] := Directory;
    Info.Values['SPEC'] := Spec;
    AddQueueItem(Info, TListFilesWorkerThread, aReturnInfo);
  finally
    Info.Free;
  end;
end;

procedure TForm1.btnScanDirClick(Sender: TObject);
begin
  AddScanFolder('C:\Temp\', '*.*', ReturnInfo);
end;

procedure TForm1.AddScanJob(List: TStrings);
begin
  if List.Count > 0 then
  begin
    AddQueueItem(List, TScanFileItems, ReturnInfoScan);
    List.Clear;
  end;
end;

procedure TForm1.AddMemoInfo(aMemo: TMemo; Info: TStrings);
const
  MaxLines = 500;
  Delta = 50;
begin
  aMemo.Lines.BeginUpdate;
  try
    if aMemo.Lines.Count > MaxLines then
      while aMemo.Lines.Count > MaxLines - Delta do
        aMemo.Lines.Delete(0);
    aMemo.Lines.AddStrings(Info);
  finally
    aMemo.Lines.EndUpdate;
  end;
  aMemo.SelStart := Length(aMemo.Text);
  aMemo.SelLength := 0;
end;

procedure TForm1.ReturnInfoScan(Sender: TObject; Info: TStrings);
var List: TStrings;
begin
  List := TStringList.Create;
  try
    List.Text := Info.Values['FILEDATES'];
    AddProgress(List.Count);
    AddMemoInfo(memFileList, List);
  finally
    List.Free;
  end;
end;

procedure TForm1.ReturnInfo(Sender: TObject; Info: TStrings);
var
  List, SubList: TStrings;
  Numlines, I: Integer;
begin
  AddMemoInfo(memFileList, Info);
  if (Info.Count > 0) and (Copy(Info[0], 1, 7) = 'FILES= ') then
  begin
    List := TStringList.Create;
    try
      NumLines := 0;
      List.Text := Copy(Info[0], 10, Length(Info.Text));
      SetProgress(List.Count, 1);
      SubList := TStringList.Create;
      try
        for I := 0 to List.Count - 1 do
        begin
          SubList.Add(List[I]);
          Inc(NumLines);
          if NumLines mod 5 = 0 then
            AddScanJob(SubList);
        end;
        AddScanJob(SubList);
      finally
        SubList.Free;
      end;
    finally
      List.Free;
    end;
  end;
end;

procedure TForm1.SetProgress(aNum, aNumType: integer);
var pb: TProgressBar;
begin
  pb := ProgressBar1;
  case aNumType of
    0: pb.Position := aNum;
    1:
    begin
      pb.Position := 0;
      pb.Max := aNum;
    end;
  end;
  pb.Update;
end;

procedure TForm1.AddProgress(aNum: Integer);
begin
  SetProgress(aNum + ProgressBar1.Position);
end;

end.

Open in new window

0
 
LVL 14

Author Comment

by:systan
ID: 32796643
Hello
I'm back

Geert
I've tested your last shot code, its super fast, but it pauses a litle during a click, probably because it gets the filecounts of all files to be scanned, and the ___progressbar doesn't show_____.  Even if you have declared it in the code.

Epasquier
Your code to is super fast also, faster than Geert because it does not get the number of files before scanning,  and it ___does not do a progressbar___.

To both of you
I wonder if you've test my code thats running fine, only the progressbar correction is important.
I wonder also before you submit your codes, did you really test it, or run it on your system? like c:\

This post is to long for easy questions on brilliiant experts like you, I don't know if there is something you can submit again,  that when I test it and run it on my "c drive" I will notice directly the progressbar, because the important question here is the showing of the progressbar or correcting progressbar value while scanning files.

Anyway, I have to wait for one last shot for both of you(if there is left on you), It's not hard to accept answers that is not fairly answered for both of you because you've contributed very well,  but the important of the help question is must.

Thanks
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32796886
there is a bug ...

if you don't change the code it will only work for c:\temp

:)
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32796907
Tested ?
Yes, and yes for the C:, it does take a long while for it to finish with counting of the files

the progressbar works

it's the reading of the filelist which takes long
that approach needs some work
0
 
LVL 14

Author Comment

by:systan
ID: 32797063
Geert
Ok, really nothing show's to my screen of progressbar, iLL test many times again and again...


Epasquier
Nice try, I've notice that your code does ALL folders scanning, so I may count ALL folders first to progressbar.max
then eventualy increases progressbar.value during file scan.
Now I get what your code does.
0
 
LVL 25

Accepted Solution

by:
epasquier earned 1200 total points
ID: 32798875
Here is the altered code based on Geert article. It uses thes same mechanism to signal progress to the form, but with a modification : it can manage a multi-step work, with clear signal of starting job, steps, progress on each step or globally (with pondered progress on each steps for the global percentage), and step or job termination, or cancelation.

The actual work is only sleeping a bit during each 'run' of each step as in Geert article, only this simulated time is variable for each step.

So that is what I meant by Geert article is a very good basis for thread to form signaling, and there is only to insert the real files operations in this now. I'll do it shortly, by you can already play with that.
/*==== Unit1.PAS file  ===============================================

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Gauges, ExtCtrls;

type
  TProgressProc = procedure (aStep, aProgress,aProgressMax: Integer) of object;
  TProgressThread = class(TThread)
  private
    FMaxStep,FStep:Integer;
    FProgressProc: TProgressProc;
    FProgressValue,FProgressMax: integer;
    procedure SynchedProgress;
  protected
    procedure Progress(aStep, aProgress, aProgressMax: integer); virtual;
  public
    constructor Create(aProgressProc: TProgressProc; CreateSuspended: Boolean = False); reintroduce; virtual;
  end;

  TMyThread = class(TProgressThread)
  protected
    procedure Execute; override;
  end;

  TForm1 = class(TForm)
    btnStart: TButton;
    pbGlobal: TGauge;
    lblGlobal: TLabel;
    btnStop: TButton;
    btnPause: TButton;
    btnResume: TButton;
    pnlSteps: TPanel;
    pnl1: TPanel;
    pb1: TGauge;
    lbl1: TLabel;
    lblScanDir: TLabel;
    pnl2: TPanel;
    pb2: TGauge;
    lbl2: TLabel;
    lblListFiles: TLabel;
    pnl3: TPanel;
    pb3: TGauge;
    lbl3: TLabel;
    lblVirusScan: TLabel;
    procedure btnStartClick(Sender: TObject);
    procedure btnPauseClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnResumeClick(Sender: TObject);
  private
    fMyThread: TMyThread;
    procedure UpdateProgressBar(aStep, aProgress, aProgressMax: Integer);
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

Const
 GLOBAL_PROGRESS     = -1;
 PROGRESS_JOB_START  = -2;
 PROGRESS_STEP_START = -1;
 PROGRESS_STEP_BREAK = $7FFFFFF8;
 PROGRESS_STEP_END   = $7FFFFFF9;
 PROGRESS_JOB_BREAK  = $7FFFFFFE;
 PROGRESS_JOB_TERMINATED = $7FFFFFFF;

Const
 NB_JOB_STEPS=3;
 SLEEP_TIME_STEPS:Array [0..NB_JOB_STEPS-1] Of Integer=(10,30,100);
 NB_RUNS=120;


{ TProgressThread }
constructor TProgressThread.Create(aProgressProc: TProgressProc; CreateSuspended: Boolean = False);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
  FProgressProc := aProgressProc;
  FMaxStep:=NB_JOB_STEPS;
end;

procedure TProgressThread.Progress(aStep, aProgress,aProgressMax: Integer);
begin
  FProgressValue := aProgress;
  FProgressMax := aProgressMax;
  FStep := aStep;
  Synchronize(SynchedProgress);
end;

procedure TProgressThread.SynchedProgress;
begin
  if Assigned(FProgressProc) then
    FProgressProc(FStep, FProgressValue,FProgressMax);
end;

{ TMyThread }
procedure TMyThread.Execute;
var
 S,I: Integer;
 MaxWork,WorkDone:Integer;
begin
 MaxWork:=0;
 WorkDone:=0;
 for S:=0 to FMaxStep-1 do MaxWork:=MaxWork+SLEEP_TIME_STEPS[S];

 Progress(GLOBAL_PROGRESS, PROGRESS_JOB_START, MaxWork);
 for S:=0 to FMaxStep-1 do
  begin
   Progress(GLOBAL_PROGRESS, WorkDone , MaxWork);
   Progress(S, PROGRESS_STEP_START, NB_RUNS);
   for I := 1 to NB_RUNS do
    begin
     Sleep(SLEEP_TIME_STEPS[S]);
     Progress(S, I, NB_RUNS);
     if Terminated Then Break;
    end;
   if Terminated Then
    begin
     Progress(S, PROGRESS_STEP_BREAK, NB_RUNS);
     Break;
    end else
    begin
     Progress(S, PROGRESS_STEP_END, NB_RUNS);
     WorkDone:=WorkDone+SLEEP_TIME_STEPS[S];
    end;
  end;
 if Terminated
  Then Progress(GLOBAL_PROGRESS, PROGRESS_JOB_BREAK, FMaxStep)
  Else Progress(GLOBAL_PROGRESS, PROGRESS_JOB_TERMINATED, FMaxStep);
end;

{ TForm1 }
procedure TForm1.UpdateProgressBar(aStep, aProgress, aProgressMax: Integer);
var
 PBar:TGauge;
 lbl:TLabel;
 pnl:TPanel;
begin
 Case aStep of
  GLOBAL_PROGRESS:
     begin
      PBar:=pbGlobal;
      lbl:=lblGlobal;
      pnl:=pnlSteps;
     end;
  0: begin
      PBar:=pb1;
      lbl:=lbl1;
      pnl:=pnl1;
     end;
  1: begin
      PBar:=pb2;
      lbl:=lbl2;
      pnl:=pnl2;
     end;
  2: begin
      PBar:=pb3;
      lbl:=lbl3;
      pnl:=pnl3;
     end;
  Else Exit;
 end;
 if aProgress=PROGRESS_JOB_START Then
  begin
   btnStart.Enabled:=False;
   btnPause.Enabled:=True;
   btnStop.Enabled:=True;
   PBar.MinValue:=0;
   PBar.MaxValue := aProgressMax;
   PBar.Progress := 0;
   lbl.Caption:='Job Started';
   pnl.Visible:=True;
   pnl1.Visible:=False;
   pnl2.Visible:=False;
   pnl3.Visible:=False;
  end Else
 if aProgress=PROGRESS_STEP_START Then
  begin
   pnl.Visible:=True;
   PBar.MinValue:=0;
   PBar.MaxValue := aProgressMax;
   PBar.Progress := 0;
   lbl.Caption:=Format('Starting step %d',[aStep+1]);
  end Else
 if aProgress = PROGRESS_STEP_END Then
  begin
   PBar.Progress := PBar.MaxValue;
   lbl.Caption:='Step finished';
  end Else
 if aProgress = PROGRESS_STEP_BREAK Then
  begin
   lbl.Caption:='Step canceled';
  end  Else
 if (aProgress = PROGRESS_JOB_BREAK) Or
    (aProgress = PROGRESS_JOB_TERMINATED) then
  begin
   if aProgress = PROGRESS_JOB_BREAK Then lbl.Caption:='Job canceled' Else
    begin
     PBar.Progress := PBar.MaxValue;
     lbl.Caption:='Job finished';
    end;
   btnStart.Enabled:=True;
   btnPause.Enabled:=False;
   btnStop.Enabled:=False;
   btnPause.Visible:=True;
   fMyThread := nil;
  end Else
  begin
//   PBar.MaxValue := aProgressMax;
   PBar.Progress := aProgress;
  end;
 PBar.Update; // Make sure to repaint the progressbar
 lbl.Update;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  if not Assigned(fMyThread) then
    fMyThread := TMyThread.Create(UpdateProgressBar);
end;

procedure TForm1.btnPauseClick(Sender: TObject);
begin
 if Assigned(fMyThread) then
    fMyThread.Suspend;
 btnPause.Visible:=False;
end;

procedure TForm1.btnResumeClick(Sender: TObject);
begin
 if Assigned(fMyThread) then
    fMyThread.Resume;
 btnPause.Visible:=True;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
 if Assigned(fMyThread) then
  begin
   fMyThread.Resume;
   fMyThread.Terminate;
  end;
end;

end.


/*==== Unit1.DFM file  ===============================================

object Form1: TForm1
  Left = 412
  Top = 114
  Width = 765
  Height = 277
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 16
  object pbGlobal: TGauge
    Left = 16
    Top = 48
    Width = 513
    Height = 25
    ForeColor = clNavy
    Progress = 0
  end
  object lblGlobal: TLabel
    Left = 535
    Top = 52
    Width = 3
    Height = 16
  end
  object btnResume: TButton
    Left = 72
    Top = 16
    Width = 60
    Height = 25
    Caption = 'Resume'
    TabOrder = 3
    OnClick = btnResumeClick
  end
  object btnStart: TButton
    Left = 8
    Top = 16
    Width = 60
    Height = 25
    Caption = 'Start'
    TabOrder = 0
    OnClick = btnStartClick
  end
  object btnStop: TButton
    Left = 136
    Top = 16
    Width = 60
    Height = 25
    Caption = 'Stop'
    TabOrder = 1
    OnClick = btnStopClick
  end
  object btnPause: TButton
    Left = 72
    Top = 16
    Width = 60
    Height = 25
    Caption = 'Pause'
    TabOrder = 2
    OnClick = btnPauseClick
  end
  object pnlSteps: TPanel
    Left = 8
    Top = 80
    Width = 729
    Height = 153
    BevelOuter = bvLowered
    TabOrder = 4
    Visible = False
    object pnl1: TPanel
      Left = 8
      Top = 8
      Width = 713
      Height = 41
      TabOrder = 0
      object pb1: TGauge
        Left = 112
        Top = 8
        Width = 400
        Height = 25
        ForeColor = clNavy
        Progress = 0
      end
      object lbl1: TLabel
        Left = 519
        Top = 12
        Width = 3
        Height = 16
      end
      object lblScanDir: TLabel
        Left = 8
        Top = 12
        Width = 99
        Height = 16
        Caption = 'Scan Directories'
      end
    end
    object pnl2: TPanel
      Left = 8
      Top = 56
      Width = 713
      Height = 41
      TabOrder = 1
      object pb2: TGauge
        Left = 112
        Top = 8
        Width = 400
        Height = 25
        ForeColor = clNavy
        Progress = 0
      end
      object lbl2: TLabel
        Left = 519
        Top = 12
        Width = 3
        Height = 16
      end
      object lblListFiles: TLabel
        Left = 8
        Top = 12
        Width = 52
        Height = 16
        Caption = 'List Files'
      end
    end
    object pnl3: TPanel
      Left = 8
      Top = 104
      Width = 713
      Height = 41
      TabOrder = 2
      object pb3: TGauge
        Left = 112
        Top = 8
        Width = 400
        Height = 25
        ForeColor = clNavy
        Progress = 0
      end
      object lbl3: TLabel
        Left = 519
        Top = 12
        Width = 3
        Height = 16
      end
      object lblVirusScan: TLabel
        Left = 8
        Top = 12
        Width = 96
        Height = 16
        Caption = 'Virus Scan Files'
      end
    end
  end
end

Open in new window

0
 
LVL 14

Author Closing Comment

by:systan
ID: 32799386
Why it's so hard so mixed the progressbar or guagebar to a scanning file?
Actually its a good sample for guagebar.

And now there is a progressbar/guagebar, but where is the scanning file?
lol, Now I know it's really hard to assigned scanning file with progressbar.

Thanks anyway, I have to do it my self, ofcourse with the help of your samples.

Cheers
0
 
LVL 25

Expert Comment

by:epasquier
ID: 32800374
You didn't wait for the net result. Doesn't mind I fully agree with the points share with Geert as his article is the root of this complete solution :
Full file search & scanning with multi-step gauge.

Now you can concentrate on actually do the virus scanning of a file
// .PAS

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Gauges, ExtCtrls, ImgList;

Const
 NB_JOB_STEPS=3;
 SLEEP_TIME_STEPS:Array [0..NB_JOB_STEPS-1] Of Integer=(1,3,10);

type
 TSearchOption=(soRecurse,soFullName,soClearList,soResIncludeDir);
 TSearchOptions=Set of TSearchOption;

  TProgressProc = procedure (aStep, aProgress,aProgressMax: Integer) of object;
  TProgressThread = class(TThread)
  private
    FMaxStep,FStep:Integer;
    FProgressProc: TProgressProc;
    FProgressValue,FProgressMax: integer;
    procedure SynchedProgress;
  protected
    procedure Progress(aStep, aProgress, aProgressMax: integer); virtual;
  public
    constructor Create(aProgressProc: TProgressProc; CreateSuspended: Boolean = False); reintroduce; virtual;
  end;

  TListFilesWorkerThread = class(TProgressThread)
  private
    FPath:TStringList;
    FExt:TStringList;
    FDirList:TStrings;
    FFileList:TStrings;
    procedure FindFiles(Dir,Search:String;Res:TStrings;OrAttr:Integer=faAnyFile;AndAttr:Integer=0;Options:TSearchOptions=[];SubDir:STring='';FixedSubDir:String='';Level:integer=0);
  protected
    NB_RUNS:Array[0..NB_JOB_STEPS-1] Of Integer;
    procedure Execute; override;
  public
    constructor Create(Path,Filter:String;aProgressProc: TProgressProc; CreateSuspended: Boolean = False); reintroduce;
    Destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    pnlSteps: TPanel;
    pnl1: TPanel;
    pb1: TGauge;
    lbl1: TLabel;
    lblScanDir: TLabel;
    pnl2: TPanel;
    pb2: TGauge;
    lbl2: TLabel;
    lblListFiles: TLabel;
    pnl3: TPanel;
    pb3: TGauge;
    lbl3: TLabel;
    lblVirusScan: TLabel;
    pnl4: TPanel;
    btnResume: TButton;
    btnStart: TButton;
    btnStop: TButton;
    btnPause: TButton;
    pbGlobal: TGauge;
    lblGlobal: TLabel;
    edtPath: TEdit;
    lblPath: TLabel;
    edtExt: TEdit;
    lbl4: TLabel;
    lvFiles: TListView;
    ilFileStates: TImageList;
    procedure btnStartClick(Sender: TObject);
    procedure btnPauseClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnResumeClick(Sender: TObject);
  private
    fMyThread: TListFilesWorkerThread;
    procedure UpdateProgressBar(aStep, aProgress, aProgressMax: Integer);
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

Const
 GLOBAL_PROGRESS     = -1;
 PROGRESS_JOB_START  = -2;
 PROGRESS_STEP_START = -1;
 PROGRESS_STEP_BREAK = $7FFFFFF8;
 PROGRESS_STEP_END   = $7FFFFFF9;
 PROGRESS_JOB_BREAK  = $7FFFFFFE;
 PROGRESS_JOB_TERMINATED = $7FFFFFFF;

{ TProgressThread }
constructor TProgressThread.Create(aProgressProc: TProgressProc; CreateSuspended: Boolean = False);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
  FProgressProc := aProgressProc;
  FMaxStep:=NB_JOB_STEPS;
end;

procedure TProgressThread.Progress(aStep, aProgress,aProgressMax: Integer);
begin
  FProgressValue := aProgress;
  FProgressMax := aProgressMax;
  FStep := aStep;
  Synchronize(SynchedProgress);
end;

procedure TProgressThread.SynchedProgress;
begin
  if Assigned(FProgressProc) then
    FProgressProc(FStep, FProgressValue,FProgressMax);
end;

{ TListFilesWorkerThread }

constructor TListFilesWorkerThread.Create(Path,Filter:String; aProgressProc: TProgressProc; CreateSuspended: Boolean = False);
begin
 FPath:=TStringList.Create;
 FPath.Delimiter:=';';
 FPath.DelimitedText:=Path;
 FExt:=TStringList.Create;
 FExt.Delimiter:=';';
 FExt.DelimitedText:=Filter;
// FDirList:=DirList;
// FFileList:=FileList;
 FDirList:=TStringList.Create;
 FFileList:=TStringList.Create;
 inherited Create(aProgressProc, CreateSuspended);
end;

Destructor TListFilesWorkerThread.Destroy;
begin
 FPath.Free;
 FExt.Free;
 FDirList.Free;
 FFileList.Free;
end;

procedure TListFilesWorkerThread.FindFiles(Dir,Search:String;Res:TStrings;OrAttr:Integer=faAnyFile;AndAttr:Integer=0;Options:TSearchOptions=[];SubDir:STring='';FixedSubDir:String='';Level:integer=0);
Var
 R:TSearchRec;
 S:String;
 R2:TStringList;
 i:integer;
begin
 Dir:=IncludeTrailingBackslash(Dir);
 OrAttr:=OrAttr Or AndAttr;
 if SubDir<>'' Then SubDir:=IncludeTrailingBackSlash(SubDir);
 if FixedSubDir<>'' Then FixedSubDir:=IncludeTrailingBackSlash(FixedSubDir);
 if soClearList IN Options Then
  begin
   for i:=0 to Res.Count-1 do try Res.Objects[i].Free except end;
   Res.Clear;
   Options:=Options-[soClearList];
  end;
 try
  // if soRecurse IN Options Then OrAttr:=OrAttr Or faDirectory;
   if FindFirst(Dir+SubDir+FixedSubDir+Search,OrAttr,R)=0 then
    repeat
     if ((R.Attr And AndAttr)=AndAttr) And (R.Name[1]<>'.') Then
      begin
       S:=SubDir+FixedSubDir+R.Name;
  //     S:=UpperCase(S);
       if soFullName IN Options Then Res.Add(Dir+S) Else Res.Add(S);
      end;
     if Terminated Then Break;
    until FindNext(R)<>0;
   FindClose(R);
   if (soRecurse IN Options) And (FindFirst(Dir+SubDir+FixedSubDir+'*.*',faDirectory,R)=0) then
    repeat
     if ((R.Attr And faDirectory)>0) And (R.Name[1]<>'.') Then
      begin
       R2:=TStringList.Create;
       FindFiles(Dir,Search,R2,OrAttr,AndAttr,Options,SubDir+R.Name,FixedSubDir,Level+1);
       if R2.Count>0 Then
        begin
         if (soResIncludeDir IN Options) Then Res.Add(Format('*%d*',[Level+1])+SubDir+FixedSubDir+R.Name);
         Res.AddStrings(R2);
        end;
       R2.Free;
      end;
    until FindNext(R)<>0;
 Except
  Terminate;
 end;
 FindClose(R);
end;

procedure TListFilesWorkerThread.Execute;
var
 S,I: Integer;
 MaxWork,WorkDone:Integer;
begin
 MaxWork:=0;
 WorkDone:=0;
 for S:=0 to FMaxStep-1 do MaxWork:=MaxWork+SLEEP_TIME_STEPS[S];

 try
 Progress(GLOBAL_PROGRESS, PROGRESS_JOB_START, MaxWork);
 for S:=0 to FMaxStep-1 do
  begin
   Case S Of
    0:begin
       NB_RUNS[S]:=FPath.Count;
       FDirList.Clear;
       //Synchronize();
      end;
    1:begin
       NB_RUNS[S]:=FPath.Count*FExt.Count;
       FFileList.Clear;
       //Synchronize();
      end;
    2:begin
       NB_RUNS[S]:=FFileList.Count;
      end;
   End;

   Progress(GLOBAL_PROGRESS, WorkDone , MaxWork);
   Progress(S, PROGRESS_STEP_START, NB_RUNS[S]);
   for I := 0 to NB_RUNS[S]-1 do
    try
     Case S Of
      0: FindFiles(FPath[i],'*.*',FDirList,faDirectory,faDirectory,[soRecurse,soFullName]);
      1: FindFiles(FPath[i Mod NB_RUNS[0]],FExt[i Div NB_RUNS[0]],FFileList,faAnyFile-faDirectory,0,[soRecurse,soFullName]);
      2: Sleep(SLEEP_TIME_STEPS[S]);
     End;
     Progress(S, i+1, NB_RUNS[S]);
     if Terminated Then Break;
    except
     Terminate;
    end;
   if Terminated Then
    begin
     Progress(S, PROGRESS_STEP_BREAK, NB_RUNS[S]);
     Break;
    end else
    begin
     Progress(S, PROGRESS_STEP_END, NB_RUNS[S]);
     WorkDone:=WorkDone+SLEEP_TIME_STEPS[S];
    end;
  end;
 except
  Terminate;
 end;
 if Terminated
  Then Progress(GLOBAL_PROGRESS, PROGRESS_JOB_BREAK, FMaxStep)
  Else Progress(GLOBAL_PROGRESS, PROGRESS_JOB_TERMINATED, FMaxStep);
end;

{ TForm1 }
procedure TForm1.UpdateProgressBar(aStep, aProgress, aProgressMax: Integer);
var
 PBar:TGauge;
 lbl:TLabel;
 pnl:TPanel;
 i:integer;
 it:TListItem;
begin
 Case aStep of
  GLOBAL_PROGRESS:
     begin
      PBar:=pbGlobal;
      lbl:=lblGlobal;
      pnl:=pnlSteps;
     end;
  0: begin
      PBar:=pb1;
      lbl:=lbl1;
      pnl:=pnl1;
     end;
  1: begin
      PBar:=pb2;
      lbl:=lbl2;
      pnl:=pnl2;
     end;
  2: begin
      PBar:=pb3;
      lbl:=lbl3;
      pnl:=pnl3;
      if aProgress=PROGRESS_STEP_START Then
       begin
        lvFiles.Clear;
        for i := 0 to fMyThread.FFileList.Count - 1 do
         begin
          it:=lvFiles.Items.Add;
          it.Caption:=ExtractFileName(fMyThread.FFileList[i]);
          it.SubItems.Add(ExtractFileDir(fMyThread.FFileList[i]));
          it.ImageIndex:=0;
         end;
       end else
      if aProgress<PROGRESS_STEP_BREAK then
       begin
        if aProgress>0 Then
         begin
          if Random(100)>0
           Then lvFiles.Items[aProgress-1].ImageIndex:=2  // Ok
           Else lvFiles.Items[aProgress-1].ImageIndex:=3; // Virus found
         end;
        if aProgress<aProgressMax Then lvFiles.Items[aProgress].ImageIndex:=1; // Scaning
       end;
     end;
  Else Exit;
 end;
 if aProgress=PROGRESS_JOB_START Then
  begin
   edtPath.Enabled:=False;
   edtExt.Enabled:=False;
   btnStart.Enabled:=False;
   btnPause.Enabled:=True;
   btnStop.Enabled:=True;
   PBar.MinValue:=0;
   PBar.MaxValue := aProgressMax;
   PBar.Progress := 0;
   lbl.Caption:='Job Started';
   pnl.Visible:=True;
   pnl1.Visible:=False;
   pnl2.Visible:=False;
   pnl3.Visible:=False;
  end Else
 if aProgress=PROGRESS_STEP_START Then
  begin
   pnl.Visible:=True;
   PBar.MinValue:=0;
   PBar.MaxValue := aProgressMax;
   PBar.Progress := 0;
   lbl.Caption:=Format('Starting %d',[aProgressMax]);
  end Else
 if aProgress = PROGRESS_STEP_END Then
  begin
   PBar.Progress := PBar.MaxValue;
   lbl.Caption:=Format('finished %d',[PBar.MaxValue]);
  end Else
 if aProgress = PROGRESS_STEP_BREAK Then
  begin
   lbl.Caption:=Format('Canceled at %d/%d',[PBar.Progress,PBar.MaxValue]);
  end  Else
 if (aProgress = PROGRESS_JOB_BREAK) Or
    (aProgress = PROGRESS_JOB_TERMINATED) then
  begin
   if aProgress = PROGRESS_JOB_BREAK Then lbl.Caption:='Job canceled' Else
    begin
     PBar.Progress := PBar.MaxValue;
     lbl.Caption:='Job finished';
    end;
   btnStart.Enabled:=True;
   btnPause.Enabled:=False;
   btnStop.Enabled:=False;
   btnPause.Visible:=True;
   edtPath.Enabled:=True;
   edtExt.Enabled:=True;
   fMyThread := nil;
  end Else
  begin
   PBar.Progress := aProgress;
   lbl.Caption:=Format('Working... %d/%d',[aProgress,PBar.MaxValue]);
  end;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  if not Assigned(fMyThread) then
    fMyThread := TListFilesWorkerThread.Create(edtPath.Text,edtExt.Text,UpdateProgressBar);
end;

procedure TForm1.btnPauseClick(Sender: TObject);
begin
 if Assigned(fMyThread) then
    fMyThread.Suspend;
 btnPause.Visible:=False;
end;

procedure TForm1.btnResumeClick(Sender: TObject);
begin
 if Assigned(fMyThread) then
    fMyThread.Resume;
 btnPause.Visible:=True;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
 if Assigned(fMyThread) then
  begin
   fMyThread.Resume;
   fMyThread.Terminate;
  end;
end;

end.

//=== DFM

object Form1: TForm1
  Left = 412
  Top = 114
  BorderWidth = 8
  Caption = 'Form1'
  ClientHeight = 583
  ClientWidth = 1310
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 16
  object pnlSteps: TPanel
    Left = 0
    Top = 73
    Width = 1310
    Height = 153
    Align = alTop
    BevelOuter = bvLowered
    TabOrder = 0
    Visible = False
    object pnl1: TPanel
      Left = 8
      Top = 8
      Width = 713
      Height = 41
      TabOrder = 0
      object pb1: TGauge
        Left = 112
        Top = 8
        Width = 400
        Height = 25
        ForeColor = clNavy
        Progress = 0
      end
      object lbl1: TLabel
        Left = 519
        Top = 12
        Width = 3
        Height = 16
      end
      object lblScanDir: TLabel
        Left = 8
        Top = 12
        Width = 99
        Height = 16
        Caption = 'Scan Directories'
      end
    end
    object pnl2: TPanel
      Left = 8
      Top = 56
      Width = 713
      Height = 41
      TabOrder = 1
      object pb2: TGauge
        Left = 112
        Top = 8
        Width = 400
        Height = 25
        ForeColor = clNavy
        Progress = 0
      end
      object lbl2: TLabel
        Left = 519
        Top = 12
        Width = 3
        Height = 16
      end
      object lblListFiles: TLabel
        Left = 8
        Top = 12
        Width = 52
        Height = 16
        Caption = 'List Files'
      end
    end
    object pnl3: TPanel
      Left = 8
      Top = 104
      Width = 713
      Height = 41
      TabOrder = 2
      object pb3: TGauge
        Left = 112
        Top = 8
        Width = 400
        Height = 25
        ForeColor = clNavy
        Progress = 0
      end
      object lbl3: TLabel
        Left = 519
        Top = 12
        Width = 3
        Height = 16
      end
      object lblVirusScan: TLabel
        Left = 8
        Top = 12
        Width = 96
        Height = 16
        Caption = 'Virus Scan Files'
      end
    end
  end
  object pnl4: TPanel
    Left = 0
    Top = 0
    Width = 1310
    Height = 73
    Align = alTop
    BevelOuter = bvLowered
    Constraints.MaxWidth = 1310
    Constraints.MinWidth = 728
    TabOrder = 1
    object pbGlobal: TGauge
      Left = 8
      Top = 40
      Width = 513
      Height = 25
      ForeColor = clNavy
      Progress = 0
    end
    object lblGlobal: TLabel
      Left = 527
      Top = 44
      Width = 3
      Height = 16
    end
    object lblPath: TLabel
      Left = 8
      Top = 11
      Width = 27
      Height = 16
      Caption = 'Path'
    end
    object lbl4: TLabel
      Left = 376
      Top = 11
      Width = 18
      Height = 16
      Caption = 'Ext'
    end
    object btnResume: TButton
      Left = 592
      Top = 8
      Width = 60
      Height = 25
      Caption = 'Resume'
      TabOrder = 0
      OnClick = btnResumeClick
    end
    object btnStart: TButton
      Left = 528
      Top = 8
      Width = 60
      Height = 25
      Caption = 'Start'
      TabOrder = 1
      OnClick = btnStartClick
    end
    object btnStop: TButton
      Left = 656
      Top = 8
      Width = 60
      Height = 25
      Caption = 'Stop'
      TabOrder = 2
      OnClick = btnStopClick
    end
    object btnPause: TButton
      Left = 592
      Top = 8
      Width = 60
      Height = 25
      Caption = 'Pause'
      TabOrder = 3
      OnClick = btnPauseClick
    end
    object edtPath: TEdit
      Left = 40
      Top = 8
      Width = 329
      Height = 24
      TabOrder = 4
      Text = 'D:\Delphi\Projects;D:\Delphi\Units'
    end
    object edtExt: TEdit
      Left = 400
      Top = 8
      Width = 121
      Height = 24
      TabOrder = 5
      Text = '*.pas;*.dfm'
    end
  end
  object lvFiles: TListView
    Left = 0
    Top = 226
    Width = 1310
    Height = 357
    Align = alClient
    Columns = <
      item
        Caption = 'File Name'
        Width = 300
      end
      item
        AutoSize = True
        Caption = 'Dir'
      end>
    SmallImages = ilFileStates
    TabOrder = 2
    ViewStyle = vsReport
    ExplicitLeft = 582
    ExplicitTop = 224
    ExplicitWidth = 728
  end
  object ilFileStates: TImageList
    Left = 704
    Top = 296
    Bitmap = {
      494C010104000C00040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
      0000000000003600000028000000400000002000000001002000000000000020
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000008484840000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000005B7000005B70000000000A3777400A6737300A673
      7300A6737300A6737300A6737300A6737300A6737300A6737300A6737300A673
      7300A67373000000000000000000000000000000000000000000000000000000
      000060322000703B260000000000000000000000000000000000000000000000
      0000000000000000000000000000000000008484840000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000000005B7000005B7000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000005B7000005B7000000000000000000A3777400E6D7CF00FFE0
      CF00FFDDC700FFDAC100FFDAC100FFDAC100FFD7BC00FFD3B400FFD1B100FFCD
      B200A67373000000000000000000000000000000000000000000000000000000
      000060322000904B3000703B2600000000000000000000000000000000000000
      0000000000000000000000000000000000008484840000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000000000000005B7000005B7000005
      B700000000000000000000000000000000000000000000000000000000000000
      00000005B7000005B700000000000000000000000000A3777400E7DED400FFE9
      D300FFE6CE00FFE2C500FFE2C500FFE2C500FFDEBC00FFDBB500FFD5AB00FFD1
      B100A67373000000000000000000000000000000000000000000000000000000
      000060322000A8583800904B3000703B26000000000000000000000000000000
      0000000000000000000000000000000000008484840000000000000000000000
      00000000000000000000C6C6C600000000000000000000000000000000000000
      000000000000000000000000000000000000000000000005B7000005B6000005
      B7000005B7000000000000000000000000000000000000000000000000000005
      B7000005B70000000000000000000000000000000000A3777400EAE3DC00FFED
      DC00FFE9D300FFE6CE00FFE6CE00FFE6CE00FFE2C500FFDEBC00FFDBB500FFD3
      B400A67373000000000000000000000000000000000000000000000000000000
      000060322000A8583800A8583800904B3000703B260000000000000000000000
      0000000000000000000000000000000000008484840000000000000000000000
      0000000000008484840000000000000000000000000000000000000000000000
      00000000000000000000000000000000000000000000000000000006D7000005
      BA000005B7000005B700000000000000000000000000000000000005B7000005
      B7000000000000000000000000000000000000000000AA7E7700EDE8E300FFF1
      E300FFEDDC00FFE9D300FFE9D300FFE9D300FFE6CE00FFE2C500FFDEBC00FFD7
      BC00A67373000000000000000000000000000000000000000000000000000000
      000060322000C0644000A8583800A8583800904B3000703B2600000000000000
      0000000000000000000000000000000000008484840000000000000000000000
      0000848484000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000005B7000005B7000005B600000000000005B6000005B7000005B7000000
      00000000000000000000000000000000000000000000B3867A00F1EDE900FFF7
      ED00FFF1E300FFEDDC00FFEDDC00FFEDDC00FFE9D300FFE6CE00FFE2C500FFDA
      C100917165000000000000000000000000000000000000000000000000000000
      000060322000A8583800C0644000A8583800A8583800904B3000703B26000000
      0000000000000000000000000000000000008484840000000000000000000000
      0000000000000000000000000000000000000000000000000000000000008484
      8400000000000000000000000000000000000000000000000000000000000000
      0000000000000005B6000006C7000006C7000006CE000005B400000000000000
      00000000000000000000000000000000000000000000B3867A00F1EDE900FFF7
      ED00FFF1E300FFEDDC00FFEDDC00FFEDDC00FFE9D300FFE6CE00FFE2C500FFDA
      C100917165000000000000000000000000000000000000000000000000000000
      000060322000C0644000C0644000C0644000A8583800D5977F00603220000000
      0000000000000000000000000000000000008484840000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000006C1000005C1000006DA0000000000000000000000
      00000000000000000000000000000000000000000000BE917F00F3F3F200FFF9
      F300FFF7ED00FFF1E300FFF1E300FFF1E300FFEDDC00FFE9D300FFE6CE00FFDC
      C600A67373000000000000000000000000000000000000000000000000000000
      000060322000C0644000C0644000C0644000C064400060322000000000000000
      0000000000000000000000000000000000008484840000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000005B6000006D7000006CE000006DA000006E900000000000000
      00000000000000000000000000000000000000000000CA9C8400F6F6F600FFFF
      FE00FFF9F300FFF7ED00FFF7ED00FFF7ED00FFF1E300FFEDDC00FFE9D300FFDA
      C800A67373000000000000000000000000000000000000000000000000000000
      000060322000C0644000C0644000CB7E5F006032200000000000000000000000
      0000000000000000000000000000000000008484840000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000006E5000006DA000006D30000000000000000000006E5000006EF000000
      00000000000000000000000000000000000000000000CA9C8400F6F6F600FFFF
      FE00FFFFFE00FFF9F300FFF7ED00FFF7ED00FFF1E300FFEDDC00FFE9D300FFDA
      C800A67373000000000000000000000000000000000000000000000000000000
      000060322000C0644000CB7E5F00603220000000000000000000000000000000
      0000000000000000000000000000000000008484840000000000000000000000
      0000000000000000000000000000000000008484840084848400C6C6C6000000
      0000000000000000000000000000000000000000000000000000000000000006
      F8000006DA000006EF00000000000000000000000000000000000006F8000006
      F6000000000000000000000000000000000000000000D7A78800F9F9F9000000
      0000FFFFFE00FFFFFE00FFF9F300FFF9F300FFF7ED00FFF1E300F3C1B800F2A4
      9D00A67373000000000000000000000000000000000000000000000000000000
      000060322000EBCBBF0060322000000000000000000000000000000000000000
      0000000000000000000000000000000000008484840000000000000000000000
      0000000000000000000000000000000000008484840000000000848484000000
      00000000000000000000000000000000000000000000000000000006F6000006
      F6000006F8000000000000000000000000000000000000000000000000000006
      F6000006F60000000000000000000000000000000000E2B18D00FCFCFC000000
      000000000000FFFFFE00FFFFFE00FFFFFE00FFF9F300FFF7ED00A6737300A673
      7300A67373000000000000000000000000000000000000000000000000000000
      0000603220006032200000000000000000000000000000000000000000000000
      0000000000000000000000000000000000008484840000000000000000000000
      0000000000000000000000000000000000008484840084848400000000000000
      000000000000000000000000000000000000000000000006F6000006F6000006
      F600000000000000000000000000000000000000000000000000000000000000
      0000000000000006F600000000000000000000000000ECBA900000000000FEFE
      FE00FCFCFC00FAFAFA00FAFAFA00FAFAFA00F9F8F800F7F2EC00A6737300D7A3
      8200CC9980000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000008484840084848400848484008484
      8400848484008484840084848400848484008484840000000000000000000000
      0000000000000000000000000000000000000006F6000006F6000006F6000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000000000000000000000000000000F2C09300DCA98700DCA9
      8700DCA98700DCA98700DCA98700DCA98700DCA98700DCA98700A6737300D6A3
      8500000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000006F6000006F600000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000000000000000000000000000424D3E000000000000003E000000
      2800000040000000200000000100010000000000000100000000000000000000
      000000000000000000000000FFFFFF0000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000000000000000000FFFFFFFFFFFFFFFFC003FFFF000FFFFC
      8003F3FF7FEF9FF98003F1FF7FEF8FF38003F0FF7C6F87E78003F07F786FC3CF
      8003F03F702FF11F8003F01F712FF83F8003F01F739FFC7F8003F03F7F9FF83F
      8003F07F7FCFF19F8003F0FF7F07E3CF9003F1FF7F53C7E79807F3FF7F3F8FFB
      A007FFFF007F1FFF800FFFFFFFFF3FFF00000000000000000000000000000000
      000000000000}
  end
end

Open in new window

0
 
LVL 14

Author Comment

by:systan
ID: 32801498
Epasquier
I've seen the demo, it's nice, but very complicated for my status as a delphi user, I'm not an expert yet, so I will gladly keep the code for future reference.

I'd stay on my first code, and to simply apply the procedure that you said about getting all the folders first is a very good idea,  not only the root folders, but all of it as the mark for progressbar scanning.

So, please don't wonder if I post another question about scanning files, I hope you understand.

Geert
I think its a fair share points, but it doesn't matter to both of you, I know, because points are always raining in your fingers.

I've read a while ago while surfing the net,
Delphi programmers are the best programmers, better than any other language(s) programmer.


Delphi Rocks
Thank you
0
 
LVL 14

Author Comment

by:systan
ID: 32805328
I gues quering all folders in a drive is so slow, so I will only use the root folders as the max value for progressbar.  I have an open question about a faster folders scan, but I think there are all slow.
0
 
LVL 14

Author Comment

by:systan
ID: 32807100
I decided to use the root folders only as the basic of the progressbar.
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 32816414
i'm working on the threading mechanism
i'm changing it to work with WaitForMultipleObject instead of using sleep

this would be a queued thread mechanism which can give synchronized feedback to forms
the problem now is stopping/starting/pausing the thread to manage the worker threads

i may write a new article for that :)

0
 
LVL 46

Expert Comment

by:aikimark
ID: 32816665
that should be a good and useful article.  I look forward to reading it.
0

Featured Post

Tech or Treat! - Giveaway

Submit an article about your scariest tech experience—and the solution—and you’ll be automatically entered to win one of 4 fantastic tech gadgets.

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…
Here is a helpful source code for C++ Builder programmers that allows you to manage and manipulate HTML content from C++ code, while also handling HTML events like onclick, onmouseover, ... Some objects defined and used in this source include: …
THe viewer will learn how to use NetBeans IDE 8.0 for Windows to perform CRUD operations on a MySql database.
The viewer will learn how to use and create new code templates in NetBeans IDE 8.0 for Windows.
Suggested Courses

650 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