unit ubuscaarchivos;

{$mode delphi}

interface

uses
  Classes, SysUtils, syncobjs;

type
  // TBuscaArchivos permite agregar una lista de carpetas en las que buscar
  // un archivo.
  // La función Locate( archivo ) retorna el camino completo al archivo
  // Si no lo encuentra, el resultado es '';
  TBuscaArchivos = class(TCriticalSection)
  private
    lst: TStringList;
  public
    dirPrincipal: string;
    constructor Create;
    function Locate(archi: string): string;
    procedure add( s: string );
    destructor Destroy; override;
  end;


implementation

constructor TBuscaArchivos.Create;
begin
  inherited Create;
  dirPrincipal := '';
  lst:= TStringList.Create;
end;

function TBuscaArchivos.Locate(archi: string): string;
var
  buscando: boolean;
  ts, nombre: string;
  k: integer;
begin

  // primero probamos si el archivo tal cual existe;
  if fileexists(archi) then
  begin
    Result := archi;
    exit;
  end;



  nombre := ExtractFileName(archi);

  //buscamos en el directorio principal
  ts := dirPrincipal + DirectorySeparator + nombre;
  if fileexists(ts) then
  begin
    Result := ts;
    exit;
  end;


  enter;

  buscando := True;
  for k := 0 to lst.Count - 1 do
  begin
    ts := lst[k] + DirectorySeparator + nombre;
    if fileexists(ts) then
    begin
      buscando := False;
      break;
    end;
  end;
  leave;

  if buscando then
  begin
    ts := GetCurrentDir + DirectorySeparator + nombre;
    if fileexists(ts) then
      Result := ts
    else
      Result := '';
  end
  else
    Result := ts;

end;

procedure TBuscaArchivos.add(s: string);
begin
  lst.add( s );
end;

destructor TBuscaArchivos.Destroy;
begin
  enter;
  lst.Free;
  leave;
  inherited Destroy;
end;

end.

