Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Los mejores trucos

 
 
Herramientas Buscar en Tema Desplegado
  #2  
Antiguo 13-11-2017
bucanero bucanero is offline
Miembro
 
Registrado: nov 2013
Ubicación: Almería, España
Posts: 208
Poder: 11
bucanero Va camino a la fama
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.

Última edición por Casimiro Notevi fecha: 14-11-2017 a las 13:36:47.
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Como hago esto? multi thread?!?! MaMu OOP 7 16-04-2007 21:53:51
Cancelar cola impresion en red jmbarrio Impresión 0 21-12-2006 17:04:22
Thread bendito thread...se me pierde la ventana Seba.F1 API de Windows 5 02-02-2006 00:16:30
La cola de la novia.... marcoszorrilla Humor 6 23-05-2004 18:30:13
Base de datos multi área (multi departamento) Al González Conexión con bases de datos 0 19-03-2004 16:27:14


La franja horaria es GMT +2. Ahora son las 07:31:29.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi