Results 1 to 3 of 3

Thread: Thread Test

Threaded View

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

    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

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
  •