We help IT Professionals succeed at work.

Thread for each

systan
systan asked
on
I'd like to scan all drives at the same time, however I can't make a code too fast;

If there is one delphi expert could make a Thread for each drive that scans a file,  then this will be the code structure;
3 drives,  drive c, drive d, drive e
Drives must be in a TCheckListBox;
heres the code:
///////////////////
procedure TForm1.showdrives;
var
  DType: Integer;
  Drive: Char;
begin
CheckListBox1.Clear;
  For Drive := 'A' To 'Z' Do
  Begin
   if (GetDriveType(PChar(Drive + ':\'))= DRIVE_FIXED) OR (GetDriveType(PChar(Drive + ':\'))= DRIVE_REMOVABLE) then
   begin
        CheckListBox1.Items.Add(Format('%s:\',[Drive])  );
   end;
 end;

end;
/////////////////
//// no file filtering is ok

When 3 drives are Checked and scan(clicked once),   3 Labels must contain an active scanned file;
First Label1 is use for drive C actively scanned files
Second Label2 is use for drive D actively scanned files
Third Label3 is use for drive E actively scanned files

Each drive has each own thread;  If we will watch the threads on task_manager there should be 4 threads running.

How would we do this?

I don't know if this post sounds demanding, but I'm trying to learn each code of an experts help.


Thank you
I hope someone could do this;


As a code reference for multit-threading;
This code proceduces multih-threaded file scanning;
unit Unit1;

interface

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



type
  TScanFileEvent=procedure(Sender:TObject; Filename:string) of object;
  TScanErrorEvent=procedure(Sender:TObject; Filename:string; Error:Exception) of object;

  TScanningThread=class(TThread)
  private
    FCS:TCriticalSection;
    FIndex:integer;
    fn:string;
    err:Exception;
    FList:TStringList;
    FOnFinishedScanFile: TScanFileEvent;
    FOnAbortedScanFile: TScanFileEvent;
    FOnStartScanFile: TScanFileEvent;
    FOnFound: TScanFileEvent;
    FOnError: TScanErrorEvent;

    FLock : TMultiReadExclusiveWriteSynchronizer;


    procedure DoStartScan;
    procedure DoFinishScan;
    procedure DoAbortScan;
    procedure DoFound;
    procedure DoError;
    function GetThreadName: string;

  protected
    procedure execute; override;

  public
    constructor Create(AIndex:integer);
    destructor Destroy; override;
    procedure scan(AFilename:string);
    function IsScannig:boolean;

    property OnStartScanFile:TScanFileEvent read FOnStartScanFile write FOnStartScanFile;
    property OnFinishedScanFile:TScanFileEvent read FOnFinishedScanFile write FOnFinishedScanFile;
    property OnAbortedScanFile:TScanFileEvent read FOnAbortedScanFile write FOnAbortedScanFile;
    property OnFound:TScanFileEvent read FOnFound write FOnFound;
    property OnError:TScanErrorEvent read FOnError write FOnError;
    property ThreadName:string read GetThreadName;
    property FileName:string read fn;

    Property Lock : TMultiReadExclusiveWriteSynchronizer read FLock;
  end;



type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Label1: TLabel;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    Label2: TLabel;

    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private

    AThread : TScanningThread;
    cancelled:boolean;
    masks:array of TMask;
    total, scanned:integer;

    procedure startscan(sender:tobject; filename:string);
    procedure finishscan(sender:tobject; filename:string);
    procedure abortscan(sender:tobject; filename:string);
    procedure found(sender:tobject; filename:string);
    procedure error(sender:tobject; Filename:string; error:exception);
    function shouldScan(s:string):boolean;
    procedure scanMasks(s:string);

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MaxThread : byte;

implementation

{$R *.dfm}

var cs:TCriticalSection=nil;


{ TScanningThread }
constructor TScanningThread.Create(AIndex:integer);
begin
  FCS:=TCriticalSection.Create;
  FList:=TStringList.Create;
  FIndex:=AIndex;
  FLock := TMultiReadExclusiveWriteSynchronizer.Create;
  inherited Create(true);
end;

destructor TScanningThread.Destroy;
begin
  freeandnil(FList);
  freeandnil(FCS);
  freeandnil(FLock);
  inherited;
end;

procedure TScanningThread.DoAbortScan;
begin
  FOnAbortedScanFile(self, fn);
end;

procedure TScanningThread.DoError;
begin
  FOnError(self, fn, err);
end;

procedure TScanningThread.DoFinishScan;
begin
  OnFinishedScanFile(self, fn);
end;

procedure TScanningThread.DoStartScan;
begin
  OnStartScanFile(self, fn);
end;

procedure TScanningThread.DoFound;
begin
  OnFound(self, fn);
end;

procedure TScanningThread.execute;
var ie: integer;
begin
  while not terminated do
  try
    fn:='';
    FCS.Acquire;// extract first file if any (FIFO)
    try
       if FList.Count>0 then
      begin
        fn:=FList[0];
        FList.Delete(0);
      end;
    finally
      FCS.Release;
    end;


    if fn='' then// no file? go to sleep and get next file when woken up
    begin
      suspend;
      continue;
    end;


    try
      Synchronize(DoStartScan);

      if Terminated then
        Synchronize(DoAbortScan)
      else
        Synchronize(DoFinishScan);
    finally
    end;

  except
    on e:exception do
    begin
      err:=e;
      Synchronize(DoError);
    end;
  end;


end;

function TScanningThread.GetThreadName: string;
begin
result:='Thread '+inttostr(FIndex);
end;

function TScanningThread.IsScannig: boolean;
begin
result:=(not Suspended) or (FList.Count>0);
end;

procedure TScanningThread.scan(AFilename: string);
begin
Lock.BeginRead;
FList.Add(AFilename);
Lock.EndRead;
if Suspended then Resume;// wake up the thread if it's sleeping
end;


procedure TForm1.abortscan(sender: tobject; filename: string);
begin
  memo1.lines.add((sender as TScanningThread).ThreadName+' aborted while scanning file '+(sender as TScanningThread).Filename);
  inc(scanned);
end;

procedure TForm1.Button1Click(Sender: TObject);
var threads:array[0..5] of TScanningThread;
    i:integer;

  procedure findfiles(path:string);
  var r:tsearchrec;
  begin
    path:=IncludeTrailingPathDelimiter(path);

    if findfirst(path+'*.*', faanyfile-favolumeid, r)=0 then
    begin
      repeat
        AThread.Lock.BeginRead;
       
        if r.Attr and fadirectory=fadirectory then
        begin
          if (r.Name<>'.') and (r.Name<>'..') then findfiles(path+r.name);
        end
        else
        begin
          if shouldScan(path+r.name) then
          begin
            inc(total);
            threads[i].scan(path+r.name);
            i:=(i+1) mod MaxThread;// add each file to the next thread. when end of list, go the the first one
          end;
        end;

      //This shoud be removed, has system effects
      application.processmessages; // make sure GUI doesn't freeze;

      AThread.Lock.EndRead;
      until cancelled or (findnext(r)<>0);
      findclose(r);
    end;
  end;


begin

  timer1.enabled:=true;
  statusbar1.simpletext:='searching for files';
  total:=0;
  scanned:=0;
  cancelled:=false;
  memo1.Clear;
  memo2.Clear;
// user clicked scan

  for i:=1 to MaxThread do
  begin

    AThread := TScanningThread.Create(i);
    threads[i-1]:=TScanningThread.create(i);
    threads[i-1].OnStartScanFile:=startscan;
    threads[i-1].OnFinishedScanFile:=finishscan;
    threads[i-1].OnAbortedScanFile:=abortscan;
    threads[i-1].OnFound:=Found;
    threads[i-1].OnError:=error;

  end;

  try
    i:=0;
    findfiles('g:\');
    statusbar1.simpletext:='waiting for threads';
    // after finished searching for all files, wait for threads to finish
    repeat
      i:=0;
      while (i<MaxThread) and (not threads[i].IsScannig) do
        inc(i);
      //sleep(10);// do not kill the cpu
      //application.processmessages;// don't freeze the GUI
    until (i=MaxThread) or cancelled;// cancelled is a boolean value which is set to true when you click a cancel button
    if cancelled then
      memo1.lines.add('Scan aborted')
    else
      memo1.lines.add('Scan finished');
  finally
    statusbar1.simpletext:='finished';
    timer1.enabled:=false;
    for i:=1 to MaxThread do// terminate and destroy all threads
    begin
      threads[i-1].Terminate;
      threads[i-1].Resume;// just in case it's sleeping
      threads[i-1].WaitFor;
      //application.processmessages;// waitfor might take a little time so do not freeze the GUI
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  cancelled:=true;
end;

procedure TForm1.finishscan(sender: tobject; filename: string);
begin
AThread.Lock.BeginWrite;
memo1.lines.add((sender as TScanningThread).ThreadName+' finished scanning file '+(sender as TScanningThread).Filename);
inc(scanned);
AThread.Lock.EndWrite;
end;

function TForm1.shouldScan(s: string): boolean;
var i:integer;
begin
  i:=0;
  while (i<length(masks)) and (not masks[i].matches(s)) do
    inc(i);
  result:=i<length(masks);
end;

procedure TForm1.startscan(sender: tobject; filename: string);
begin
AThread.Lock.BeginRead;
memo1.lines.add((sender as TScanningThread).ThreadName+' started scannig file '+(sender as TScanningThread).Filename);

AThread.Lock.EndRead;
end;

procedure TForm1.found(sender: tobject; filename: string);
begin
  memo2.lines.add('found in file '+filename);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
MaxThread := 4;
scanMasks('*.exe,*.dll');
end;

procedure TForm1.FormDestroy(Sender: TObject);
var i:integer;
begin
  for i:=1 to length(masks) do
    freeandnil(masks[i-1]);
  setlength(masks, 0);
  AThread.Free;
end;

procedure TForm1.error(sender: tobject; filename:string; error: exception);
var s:string;
begin
  s:='** Error while scannig file "'+filename+'": '+error.message;
  memo1.lines.add(s);
  inc(scanned);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  label1.caption:=format('Total: %d | Scanned: %d', [total, scanned]);
end;

procedure TForm1.scanMasks(s: string);
var l:TStringList;
    i:integer;
begin
  l:=TStringList.Create;
  try
    l.CommaText:=s;
    setlength(masks, l.count);
    for i:=1 to l.count do
      masks[i-1]:=TMask.Create(l[i-1]);
  finally
    freeandnil(l);
  end;
end;

initialization
cs:=TCriticalSection.create;

finalization
  freeandnil(cs);

end.

Open in new window

Comment
Watch Question

Author

Commented:
Here's my first hour of typing the code;
To be continued;
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    CheckListBox1: TCheckListBox;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    procedure showdrives;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.showdrives;
var
  DType: Integer;
  Drive: Char;
begin
CheckListBox1.Clear;
  For Drive := 'A' To 'Z' Do
  Begin
   if (GetDriveType(PChar(Drive + ':\'))= DRIVE_FIXED) OR (GetDriveType(PChar(Drive + ':\'))= DRIVE_REMOVABLE) then
   begin
        CheckListBox1.Items.Add(Format('%s:\',[Drive])  );
   end;
 end;
CheckListBox1.Selected[0]:=true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
showdrives;
end;

var selectedNOTcheck:string;
procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin

selectedNOTcheck := Checklistbox1.Items [Checklistbox1.itemindex];
Form1.caption := selectedNOTcheck;

for i :=0 to CheckListbox1.count-1  do
begin
if CheckListBox1.Checked[i] then showmessage( Checklistbox1.Items[i] );
end;

end;

end.

Open in new window

Author

Commented:
Continuetion for 30minutes coding, so slow, oh, just a beginner.
unit Unit1;

interface

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

type
TDriveThread = class(TThread)

private
FLock : TMultiReadExclusiveWriteSynchronizer;
Findex: integer;
FList:TStringList;

protected

public
constructor Create(AIndex:integer);
destructor Destroy; override;

end;

type
  TForm1 = class(TForm)
    CheckListBox1: TCheckListBox;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    TPThread: TDriveThread;
    procedure showdrives;
    procedure Threadini;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  DThreads:array[0..25] of TDriveThread;
  MaxThread: integer;
  selectedNOTcheck:string;

implementation

{$R *.dfm}

{ TDriveThread }
constructor TDriveThread.Create(AIndex:integer);
begin
  FList:=TStringList.Create;
  FIndex:=AIndex;
  FLock := TMultiReadExclusiveWriteSynchronizer.Create;
  inherited Create(true);
end;
destructor TDriveThread.Destroy;
begin
  freeandnil(FList);
  freeandnil(FLock);
  inherited;
end;



{ TForm }
procedure TForm1.showdrives;
var
  DType: Integer;
  Drive: Char;
begin
CheckListBox1.Clear;
  For Drive := 'A' To 'Z' Do
  Begin
   if (GetDriveType(PChar(Drive + ':\'))= DRIVE_FIXED) OR (GetDriveType(PChar(Drive + ':\'))= DRIVE_REMOVABLE) then
   begin
        CheckListBox1.Items.Add(Format('%s:\',[Drive])  );
   end;
 end;
CheckListBox1.Selected[0]:=true;
MaxThread := CheckListBox1.Count;
end;

procedure TForm1.Threadini;
var i: integer;
begin
for i:=1 to MaxThread do
  begin
    TPThread := TDriveThread.Create(i);
    DThreads[i-1]:=TDriveThread.create(i);
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
showdrives;
Threadini;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin
selectedNOTcheck := Checklistbox1.Items [Checklistbox1.itemindex];
Form1.caption := selectedNOTcheck;
for i :=0 to CheckListbox1.count-1  do
begin
if CheckListBox1.Checked[i] then showmessage( Checklistbox1.Items[i] );
end;
end;



end.

Open in new window

Author

Commented:
I'm looking about this link, but it seems hard to understand;
http://edn.embarcadero.com/article/22411
http://delphi.about.com/od/kbthread/a/thread-gui.htm

Anyway  I got to continue funning delphi...

Author

Commented:
And now, I'm stock, lol, what a dumb brain, lol
Top Expert 2010
Commented:
hi Systran. Take a look to the attachment.
Threads.zip

Author

Commented:
Aflarin;
Your now a Delphi programming Master, go for Guru

Thanks
Emmanuel PASQUIERFreelance Project Manager
Top Expert 2010

Commented:
I Hope for your sake that all your drives are physically different. Otherwise, It's going to be a lot slower to have multiple threads scanning the same drive. It's better to let the scanning go one drive after the other

Author

Commented:
Aflarin;

About FindFiles! I'm gonna use PierreC's code for ParamForm paramstr scan using windows explorer contextmenu(I've done this)

And for the MainForm, I'm going to use your code, the code that you've attached.

I've done scanning with parameters
I've now the code to scan drives at the same time in different threads. (commercial antivirus don't have this)

Aflarin;  I'm going to make my own personal antivirus, do you think with the real code structures you've gave, this will be a good scanning procedures?

Ah, don't mine about virus signatures or other virus properties, I don't know it yet, but soon by a full time research.


What you say?

Author

Commented:
Oh, here is Epasquierl

>>I Hope for your sake that all your drives are physically different

This is what I am asking one of my question on my previous comments.
I have only 1 drive, with 2 logical partitions, I have drive c,d,e
And when I test the code, dragging the form with 200mb left on my memory, while scanning, its good.

>>It's going to be a lot slower to have multiple threads scanning the same drive. It's better to let the scanning go one drive after the other

I hope your not sure of this Epasquier

Thanks for dropping by, but please lets continue discussing about this.

Author

Commented:
Epasquier;
I'll restart my computer,
after boot, I'll use this code to scan all drives at the same time,
I will set and get the time for how long it takes,
after scanning....I'll restart again my computer and...
scan the drives one by one.
and take the time also.


wait..a moment, I'll be back...
Top Expert 2010

Commented:
> Your now a Delphi programming Master, go for Guru

Thanks. I will.

> (commercial antivirus don't have this)

Are you sure about that? I think they use all facilities for acceleration. Including multithreading if it is sense (see Epasquier's comment).

Author

Commented:
Ok,
Here's the result;

scan drives one by one
drive c: 53seconds
drive d: 57seconds
drive e: 51seconds
total = 1minute 41seconds

scan drives at the same time using multi-threading
7minutes 6seconds

Ok, on my mainform I'll scan drives sequencially with the CheckListBox if Checked.

Epasquier;
Thanks for dropping by and the comment is wise

Aflarin;
Congratulation on your Birth for Delphi Programming Master
I'm glad to see your Master's Shield
See you on some other post -)