Cola de elementos multi-thread

[bucanero]

Este ya es un ejemplo completo donde coge todos los ficheros de un directorio y calcula el MD5 de los mismos

Código Delphi [-]
interface

uses
  System.SysUtils, System.Classes,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, UQueueMultiThreads, IdHashMessageDigest;

type
  //cualquier tipo de dato
  TInfoFile = record
    FileName:String;
    MD5:String;
  end;

  // Se define la lista de elmentos igual que si descendiera de class(TLIST < TInfoFile >)
  TColaInfoFile=class(TQueueMultiThread < TInfoFile >);

  TMyThread2 = class(TThread < TInfoFile >)
  private
    // ------------------------------------------------
    // parte para obtener el MD5 de un fichero
    // ------------------------------------------------
    FIdHashMessageDigest5:TIdHashMessageDigest5;
    function FileMD5(FileStream: TStream): string; overload;
    function FileMD5(const FileName: string): string; overload;
    // ------------------------------------------------
    procedure ProcessItem; override;
    procedure execute; override;
  public
  end;

  TForm1 = class(TForm)
    ButtonScanDir: TButton;
    Memo1: TMemo;
    procedure ButtonScanDirClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FColaInfoFile:TColaInfoFile;
    procedure ScanDir(const ARuta:String);
    procedure FinishItem(Sender:TObject; var item:TInfoFile);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Uses idHash;

procedure TForm1.ButtonScanDirClick(Sender: TObject);
begin
  inherited;
  ScanDir('C:\a\');
end;


{ TMyThread2 }

procedure TMyThread2.execute;
begin
  try
    // se crea el objeto para obtener el MD5 de un fichero
    FIdHashMessageDigest5 := TIdHashMessageDigest5.Create;
    inherited;
  finally
    FIdHashMessageDigest5.Free;
  end;
end;

function TMyThread2.FileMD5(FileStream: TStream): string;
begin
  try
    Result := '';
    with FIdHashMessageDigest5 do
      result := LowerCase(HashStreamAsHex(FileStream));
  except
  end;
end;

function TMyThread2.FileMD5(const FileName: string): string;
var
  fs : TFileStream;
begin
  Result := '';
  try
    fs := TFileStream.Create(fileName, fmOpenRead or fmShareDenyWrite);
    try
      Result := fileMD5(fs);
    finally
      fs.Free;
    end;
  except
  end;
end;

procedure TMyThread2.ProcessItem;
begin
  FItem.MD5 := FileMD5(FItem.FileName);
end;

procedure TForm1.FinishItem(Sender: TObject; var item: TInfoFile);
begin
  with item do
    Memo1.lines.Add(ExtractFileName(FileName) + '-' + MD5);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Se crea la cola de datos indicando que se procese con la clase Thread correspondiente
  FColaInfoFile:=TColaInfoFile.Create(TMyThread2);
  //Aqui se definen el numero máximo de hilos que puede crear la cola 
  FColaInfoFile.MaxThreads:=8;
  //Aqui es donde nos devuelve el elemento ya procesado
  FColaInfoFile.OnFinishItem:=FinishItem;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FColaInfoFile.clear;
  FColaInfoFile.Free;
end;

procedure TForm1.ScanDir(const ARuta:String);
var
  searchResult: TSearchRec;
  aux: TInfoFile;
begin
  inherited;
  if findfirst(ARuta+'*', faAnyFile, searchResult) = 0 then begin
    repeat
      if (searchResult.attr and faDirectory) <> faDirectory then begin
        aux.FileName:=ARuta+searchResult.Name;
        FColaInfoFile.Add(aux);
      end;
    until FindNext(searchResult) <> 0;
    FindClose(searchResult);
  end;
end;


end.

[[ElKurgan]]

Gracias por el aporte

Saludos

[Neftali [Germán.Estévez]]

Se agradece el aporte.
Estaría bien subirlo al FTP, para tenerlo más accesible.

[bucanero]

Si, es mejor, por que ademas me he dado cuenta que en la parte del código donde se definen las clases genéricas de tipo "< T >" no han salido bien en el resaltador de sintaxis, no se si algún moderador lo puede corregir...

En cualquier caso, el proyecto completo ya esta subido al FTP del club delphi y así se puede probar de forma mas fácil :-)

http://terawiki.clubdelphi.com/Delph...ltiThreads.zip

[[AgustinOrtu]]

Empezado por bucanero

Si, es mejor, por que ademas me he dado cuenta que en la parte del código donde se definen las clases genéricas de tipo "< T >" no han salido bien en el resaltador de sintaxis, no se si algún moderador lo puede corregir...

En estos casos yo uso el resaltador de sintaxis de C/php

Gracias por el aportazo

[Neftali [Germán.Estévez]]

Empezado por bucanero

En cualquier caso, el proyecto completo ya esta subido al FTP del club delphi y así se puede probar de forma mas fácil :-)

Mucho mejor.