Помогите плиз. Использую юнит из приложения для поиска файлов по маске и диску. Область поиска целый диск. Происходит торомжение системы. Хотелось бы код с подобным принципом работы. Буду признателен за любую помощь.

Приложение:
unit search;interfaceuses Windows, SysUtils, Classes, Masks;procedure GetLogicalDriveList(const List: TStrings);procedure GetFixedDriveList(const List: TStrings);procedure FindFiles(Path, Mask: string; List: TStrings; IncludeSubDir: Boolean = True);implementationprocedure GetLogicalDriveList(const List: TStrings);varSize, Pos: Cardinal;Buffer: array[0..127] of AnsiChar;P: PChar;beginList.BeginUpdate;tryList.Clear;Size:=GetLogicalDriveStrings(SizeOf(Buffer), Buffer);Pos:=0;while Pos<Size do beginP:=@Buffer[Pos];List.Add(P);while Buffer[Pos]<>#0 do Inc(Pos);Inc(Pos);end;finallyList.EndUpdate;end;end;procedure GetFixedDriveList(const List: TStrings);varSize, Pos: Cardinal;Buffer: array[0..127] of AnsiChar;P: PChar;beginList.BeginUpdate;tryList.Clear;Size:=GetLogicalDriveStrings(SizeOf(Buffer), Buffer);Pos:=0;while Pos<Size do beginP:=@Buffer[Pos];if GetDriveType(P) = DRIVE_FIXED then List.Add(P);while Buffer[Pos]<>#0 do Inc(Pos);Inc(Pos);end;finallyList.EndUpdate;end;end;procedure FindFiles(Path, Mask: string; List: TStrings; IncludeSubDir: Boolean = True);varSearchRec: TSearchRec;FindResult: Integer;beginList.BeginUpdate;tryPath:=IncludeTrailingBackSlash(Path);FindResult:=FindFirst(Path+‘*.*‘, faAnyFile, SearchRec);trywhile FindResult = 0 do with SearchRec do beginif (Attr and faDirectory<>0) then beginif IncludeSubDir and (Name<>‘..‘) and (Name<>‘.‘)then FindFiles(Path+Name, Mask, List, IncludeSubDir);end else beginif MatchesMask(Name, Mask) then List.Add(Path+Name);end;FindResult:=FindNext(SearchRec);end;finallyFindClose(SearchRec);end;finallyList.EndUpdate;end;end;end.