Results 1 to 3 of 3

Thread: Thread Test

  1. #1
    Win32.Trojan.Heur.Herby
    Join Date
    Dec 2003
    Location
    Nuenen of all places
    Posts
    99

    Thread Test

    Vandaag eens aan het stoeien geweest met Threads, gebruik ze eigenlijk nooit.

    Uiteindelijk is het me gelukt om een SearchThread te bouwen welke bedoeld is om op de fileserver alle onnodige files van gebruikers op te schonen (delete functie zit er nog niet in).
    Sommige gebruikers met roaming profiles hebben lokaal op een laptop hun hele muziek en video collectie erin staan welke met uitloggen netjes gesynced wordt.
    Tevens staan er her en der ook nog het nodige aan deze files.

    De zoektoch begint dan ook met alle MP3/MP4/AVI/MPG

    Ik heb dan ook op alle drives een folder TEST gemaakt met bestanden erin. De uitkomst klopt in het overzicht,

    Ben dan ook zeer benieuwd of onderstaand een beetje klopt en waar ik eventueel wat gemist heb.

    Gr
    Herby

    Code:
    unit uThreadTest;
    
    interface
    
    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Types, StrUtils;
    
    
    type
    //---------------------------------------------------------------------------\\
      TSearchThread         = class(TThread)
      private
        FCurrentFolder      : string;
        FExtensionsArray    : TStringDynArray;
        FFilesFound         : TStringList;
        procedure UpdatelbFilesFound;
        procedure FindFiles (PathName: string);
      protected
        procedure Execute;    override;
      public
        constructor Create  (SearchDriveOrFolder, SearchExtensions: string);
        property  Folder    : string read FCurrentFolder;
      End;
    //---------------------------------------------------------------------------\\
      TSearchForm           = class(TForm)
        edtExtensions: TEdit;
        Label1              : TLabel;
        btnGo               : TButton;
        lbFilesFound        : TListBox;
        Label2              : TLabel;
        Label3              : TLabel;
        Memo1               : TMemo;
        CheckBox1           : TCheckBox;
        btnStop             : TButton;
        procedure FormCreate  (Sender: TObject);
        procedure FormDestroy (Sender: TObject);
        procedure btnGoClick  (Sender: TObject);
        procedure btnStopClick(Sender: TObject);
      private
        FSearchThread       : TSearchThread;
        FThreadQueue        : TStringList;
        procedure ThreadTerminate(Sender: TObject);
        procedure StartThreads;
        procedure StartThread;
      public
      end;
    //---------------------------------------------------------------------------\\
    var
      SearchForm            : TSearchForm;
    
    const
      MaxNrOfThreads        = 4;
    
    implementation
    
    uses
      Math;
    
    {$R *.dfm}
    
    //---------------------------------------------------------------------------\\
    constructor TSearchThread.Create(SearchDriveOrFolder, SearchExtensions: string);
    var
      I : Integer;
    begin
      inherited Create(True);
      FCurrentFolder  := SearchDriveOrFolder;
      FExtensionsArray := SplitString (SearchExtensions, ';');
      for I := 0 to length(FExtensionsArray) -1 do
        if Not (AnsiLeftStr(FExtensionsArray[I],1) = '.') then
          FExtensionsArray[I] := '.' + LowerCase(FExtensionsArray[I])
        else
          FExtensionsArray[I] := LowerCase(FExtensionsArray[I]);
    end;
    //---------------------------------------------------------------------------\\
    function StringInArray(Value: string; Strings: array of string): Boolean;
    var I: Integer;
    begin
      Result := False;
      for I := Low(Strings) to High(Strings) do
      Result := Result or (Value = Strings[I]);
    end;
    
    
    procedure TSearchThread.FindFiles (PathName: string);
    var
      SearchRec: TSearchRec;
      Path : String;
    begin
      Path := IncludeTrailingPathDelimiter(PathName);
    
        if FindFirst(Path + '*.*', faAnyFile - faDirectory, SearchRec) = 0 then
        try
          repeat
            if True then
              if StringInArray( LowerCase(ExtractFileExt(SearchRec.Name)) , FExtensionsArray) then
                FFilesFound.Add(Path + SearchRec.Name);
          until FindNext(SearchRec) <> 0;
        finally
          FindClose(SearchRec);
        end;
    
      if FindFirst(Path + '*.*', faDirectory, SearchRec) = 0 then
        try
          repeat
            if ((SearchRec.Attr and faDirectory) <> 0) and (SearchRec.Name <> '.') and
              (SearchRec.Name <> '..') then
              FindFiles(Path + SearchRec.Name);
          until FindNext(SearchRec) <> 0;
        finally
          FindClose(SearchRec);
        end;
    end;
    //---------------------------------------------------------------------------\\
    procedure TSearchThread.Execute;
    begin
      FFilesFound := TStringList.Create;
    
      try
        FindFiles (FCurrentFolder);
        Synchronize (UpdatelbFilesFound);
      finally
        FFilesFound.Free;
      end;
    end;
    //---------------------------------------------------------------------------\\
    procedure TSearchThread.UpdatelbFilesFound;
    begin
      With SearchForm.lbFilesFound.Items do
        begin
          BeginUpdate;
          AddStrings(FFilesFound);
          EndUpdate;
        end;
    end;
    //---------------------------------------------------------------------------\\
    //---------------------------------------------------------------------------\\
    //---------------------------------------------------------------------------\\
    procedure TSearchForm.FormCreate(Sender: TObject);
    begin
      FThreadQueue := TStringList.Create;
    end;
    //---------------------------------------------------------------------------\\
    procedure TSearchForm.FormDestroy(Sender: TObject);
    begin
      FThreadQueue.Free;
    end;
    //---------------------------------------------------------------------------\\
    procedure TSearchForm.ThreadTerminate(Sender: TObject);
    begin
      if FThreadQueue.Count > 0 then
        StartThread;
    
      if FThreadQueue.Count = 0 then
        lbFilesFound.Sorted := true;
    
    end;
    //---------------------------------------------------------------------------\\
    procedure TSearchForm.StartThreads;
    var
      i : Integer;
    begin
      for i := 1 to Min(MaxNrOfThreads, FThreadQueue.Count) do
        StartThread;
    end;
    //---------------------------------------------------------------------------\\
    procedure TSearchForm.StartThread;
    var
      DriveOrFolder : string;
    begin
      DriveOrFolder := FThreadQueue[0];
      FThreadQueue.Delete(0);
    
      FSearchThread := TSearchThread.Create(DriveOrFolder, edtExtensions.Text);
      FSearchThread.OnTerminate := ThreadTerminate;
      FSearchThread.Start;
    
    end;
    //---------------------------------------------------------------------------\\
    procedure TSearchForm.btnGoClick(Sender: TObject);
    var
      LogicalDrives : Dword;
      i             : Integer;
    begin
      Memo1.Lines.Clear;
      lbFilesFound.Clear;
    
      LogicalDrives := GetLogicalDrives;
      for i := 0 to 25 do
        if (LogicalDrives and (1 shl i)) <> 0 then
          Begin
            if CheckBox1.Checked then
              begin
                FThreadQueue.Append(Char(Ord('A') + i) + ':\TEST');
                Memo1.Lines.Add(Char(Ord('A') + i) + ':\TEST')
              end
            else  
              begin
                FThreadQueue.Append(Char(Ord('A') + i) + ':\');
                Memo1.Lines.Add(Char(Ord('A') + i) + ':\')
              end;
            
          End;
      StartThreads;
    end;
    //---------------------------------------------------------------------------\\
    procedure TSearchForm.btnStopClick(Sender: TObject);
    begin
      if FThreadQueue.Count > 0 then
        FSearchThread.Terminate;
      
    end;
    //---------------------------------------------------------------------------\\
    
    
    end.
    Attached Files Attached Files

  2. #2
    Niet minitieus nagekeken, maar de wisselwerking tussen thread en form lijkt wel goed in elkaar te zitten.

    Je gebruikt faAnyFile, waar volgens mij een issue mee is, omdat het niet alle attributen van moderne file systems bevat, maar misschien is dat in recentere Delphi's opgelost.

    Je kan gewoon een enkele loop maken door alle items in een directory. Aan het SearchRec kan je zien of het een file of een directory is en op basis daarvan kiezen wat je doet.
    Recursief zoeken werkt wel, maar heeft mij weleens in de problemen gebracht. Je kan eventueel een stringlist bouwen met een 'stack' van directories die je nog moet verwerken. Daar voeg je het eerste pad in toe, en daarna start je het zoeken in een loop. Die loop haalt de laatste directory uit de stringlist en zoekt in die directory. Elke gevonden directory voeg je weer toe aan de stringlist. Je blijft dan loopen totdat de lijst met directories leeg is.
    1+1=b

  3. #3
    Win32.Trojan.Heur.Herby
    Join Date
    Dec 2003
    Location
    Nuenen of all places
    Posts
    99
    Bedankt voor de feedback, het gaat mij in het geheel over het bouwen van threads, dat was even nieuw voor me.
    Heb getwijfeld of ik het uiteindelijke zoekwerk op deze manier zou doen of met de nieuwere functies in IOUtils.

    En dat er meerdere wegen naar Rome zijn mogen duidelijk zijn.

    Overigens gebruik ik deze functie al vaker en moet zeggen dat ik er nog geen issues mee heb gehad..... eens moet de eerste keer zijn ;-)

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •