uApiSearch

unit uApiSearch;
(*
API file search
Date  : 18.08.2013
Author: HEX0x29A
*)
interface

uses
  Windows, Messages;

type
  TSearchCallbackFunc = function(const lpPath: PWideChar;
                                 const FindData: _WIN32_FIND_DATAW): BOOL;
  // Return False = (pbSearchAbort^ = True);

  function SearchFiles(const lpSearchPath       : PWideChar;
                       const pbSearchAbort      : PBool;
                       const pFileCallback      : TSearchCallbackFunc = nil;
                       const pDirectoryCallback : TSearchCallbackFunc = nil;
                       const bRecursive         : BOOL                = True;
                       const lpFileMask         : PWideChar           = nil): BOOL;

  procedure ProcessMessages;

implementation

procedure ProcessMessages;
var
  Msg: TMsg;
  function ProcessMsg(var Msg: TMsg): BOOL;
  begin
    Result := false;
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
      Result := true;
      if Msg.Message <> WM_QUIT then
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end
      else
        DispatchMessage(Msg);
    end;
  end;
begin
  while ProcessMsg(Msg) do;
end;

function SearchFiles(const lpSearchPath       : PWideChar;
                     const pbSearchAbort      : PBool;
                     const pFileCallback      : TSearchCallbackFunc = nil;
                     const pDirectoryCallback : TSearchCallbackFunc = nil;
                     const bRecursive         : BOOL                = True;
                     const lpFileMask         : PWideChar           = nil): BOOL;
const
  DEFAUL_FILE_MASK: WideString = '*.*';
var
  fbSearchAbort : BOOL;
  fwcVariable   : WideChar;
  fwcSlash      : WideChar;
  fwsFileMask   : WideString;
  fwsSearchPath : WideString;

  function ScanDirectory(var wsSearchPath: WideString): BOOL;
  var
    fuiPathLength: UINT;
    hSearch      : UINT;
    fd           : _WIN32_FIND_DATAW;
  begin
    fuiPathLength := Length(wsSearchPath);
    hSearch := FindFirstFileW(PWideChar(WideString(wsSearchPath + fwsFileMask)), fd);
    if hSearch <> INVALID_HANDLE_VALUE then
      try
        repeat
          ProcessMessages; //PROCESS-MESSAGES
          if (Pointer(@pFileCallback) <> nil) and
             ((fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0) and
             (WideString(fd.cFileName) <> WideString('.')) and
             (fd.cFileName <> '..') then
            fbSearchAbort := (not pFileCallback(PWideChar(WideString(wsSearchPath + WideString(fd.cFileName))), fd));
          if (pbSearchAbort <> nil) and (not fbSearchAbort) then
            fbSearchAbort := pbSearchAbort^;
        until (not FindNextFileW(hSearch, fd)) or (fbSearchAbort);
      finally
        FindClose(hSearch);
      end;

    ProcessMessages; //PROCESS-MESSAGES
    Result := (not fbSearchAbort);
    if (not Result) or (not bRecursive) then
      Exit;

    hSearch := FindFirstFileW(PWideChar(WideString(wsSearchPath + DEFAUL_FILE_MASK)), fd);
    if hSearch <> INVALID_HANDLE_VALUE then
      try
        repeat
          ProcessMessages; //PROCESS-MESSAGES
          if ((fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) and
             (WideString(fd.cFileName) <> WideString('.')) and
             (fd.cFileName <> '..') then
          begin
            wsSearchPath := WideString(wsSearchPath + WideString(fd.cFileName) + fwcSlash);
            if (Pointer(@pDirectoryCallback) <> nil) then
              fbSearchAbort := (not pDirectoryCallback(PWideChar(wsSearchPath), fd));
            if (pbSearchAbort <> nil) and (not fbSearchAbort) then
              fbSearchAbort := pbSearchAbort^;
            if (fbSearchAbort) then
            begin
              Result := false;
              Break;
            end;
            Result := ScanDirectory(wsSearchPath);
            SetLength(wsSearchPath, fuiPathLength);
          end;
        until (not FindNextFileW(hSearch, fd)) or (fbSearchAbort);
      finally
        FindClose(hSearch);
      end;
  end;

begin
  fwcSlash := '\';
  if (pbSearchAbort <> nil) then
    fbSearchAbort := pbSearchAbort^
  else
    fbSearchAbort := false;
  if lpFileMask = nil then
    fwsFileMask := DEFAUL_FILE_MASK
  else
    fwsFileMask := WideString(lpFileMask);
  if (lpSearchPath = nil) or (lpSearchPath = '') then
  begin
    for fwcVariable := 'A' to 'Z' do
    begin
      fwsSearchPath := WideString(fwcVariable + WideString(':') + fwcSlash);
      Result := ScanDirectory(fwsSearchPath);
      if not Result then
        Break;
    end;
  end
  else
  begin
    fwsSearchPath := WideString(lpSearchPath);
    if (Pos('/', fwsSearchPath) <> 0) then
      fwcSlash := '/';
    if not (fwsSearchPath[Length(fwsSearchPath)] in [WideChar('\'), WideChar('/')]) then
      fwsSearchPath := WideString(fwsSearchPath + fwcSlash);
    Result := ScanDirectory(fwsSearchPath);
  end;
end;

end.