Hадпись на дисплее нового каpманного компаса под упpавлением Windows CE - "Севеp не найден."
История
Было дело, надо было создать компонент, котрый производит поиск файлов. Он был создан и в периодически дополнялся новыми возможностями. Вот и получился компонент с огромными возможностями. Единственное "но" - он был опробован только на Delphi 5 + WinNT 4.0 SP6. Но !должен! без проблем работать и в других средах....
Краткие характеристики
Компонент позволет производить поиск как на локальных дисках так и в локаольной сети.
Компонент использует многопотоковость.
Для сканирования локальных дисков используется отдельный поток, что позволяет продолжать выполнение программы.
Для сканирования удаленных компьютеров используется по одному потоку на каждый компьютер. То есть одновременно позволяет сканировать хоть все компьтеры сети.
Это усовершенствование должно заметно если не сказать "КОНКРЕТНО" повышает скорость сканирования.
Фильтрование файлов. Гарантируется, что один и тот же файл не будет дважды и более возвращен. Это может случиться при поиске файлов по нескольким маскам (Например поиск ведется по маскам [some*.*] и [*.txt] в этом случае файл somebody.txt попадает в две котегории)
Компонент ведет статистику:
Кол-во найденых файлов.
Кол-во просканированых директорий.
Время проведенное в сканировании файлов (паузы исключаются).
Вызывает OnScanDirectory. Может быть отменена в производных классах.
property Dirs: TStrings; protected;
Содержит список директорий в которых будет производиться посик.
Понимает следующие выражения:
[Drive:][\][Dir[\]] - Поиск в каталоге на локальном диске
\\ - Поиск во всех ресурсах каждого компьютера в сети
\\[Computer][\] - Поиск во всех ресурсах определенного компьютера в сети
\\[Computer][\Share][\] - Поиск в данном ресурсе определенного компьютера в сети
Комментарий:
Список используется только при ScanDirs равном sdOther.
Замечание:
Если указываются подкаталоги то при в включеной рекурсии они игнорируются.
Каталоги (*) будут игнориорваться т.к. [\\server] входит в множество [\\], а [d:\win95\temp] входит в [d:\win95]
property ScanDirs: TScanDirs; protected;
Указывает, где будет производиться поиск.
sdOther - каталоги указаны в перменной Dirs
sdCurrentDir - В текущей директории
sdCurrentDrive - На текущем диске (диск откуда запускалась программа,
но не где находится исполняемый файл)
sdFixedDrives - Только на жестких дисках (исключаются дискеты, CDROM, сетевые диски и т.п.)
sdAllDrives - На всех дисках которые присутсвеют в системе
sdAllNetwork - По всем ресурсам сети (исключаются локальные ресурсы)
property Wildcards: TStrings; protected;
Содержит список масок по которым будет производиться поиск файлов.
Например: Поиск всех файлов с расширением WAV и MP3:
*.wav
*.mp3
property Recurse: Boolean; protected;
Если True, то поиск также будет производиться в поддиректориях.
property Attributes: TFileAttributes; protected;
Указываются атрибуты искомых файлов.
Например:
[faArchive, faReadOnly] - будут найдены файлы у которых нет установленных атрибутов и файлы у которых установлены аттрибуты faArchive или faReadOnly или оба вместе.
property MaxThreads: Cardinal; protected;
Указывает максимальное количество одновременно работающих потоков. 0 - нет ограничений.
Комментарий:
Используется при поиске в локальной сети. Оптимальное значение не найдено. Но при малом значениии снижается скорость поиска, а при большом наблюдается большая загрузка ресурсов компьютера. Для поиска на локальных дисках используется один поток, т. к. использование нескольких потоков сколь нибудь заметного прироста производительности не дадут.
property OnFindFile(Sender: TObject; var FileInfo: TFileInfo); protected; event;
Вызывается если файл отвечающий условиям поиска найден.
Информация о файле содержиться в структуре FileInfo;
Время обработки этого события старайтесь сделать как можно меньше, т. к. поиск файлов вызывающий поток возобонвит только после возврата из из события.
Вызывается после того как все потоки завершили свою работу.
procedure Start(Wait: Boolean = False); public;
Собственно дает команду начать поиск.
Если Wait = True, то процедура вернет управление только когда полностью закончиться поиск. Иначе функция сразу вернет управление. Если уже идет поиск, то выбрасывается исклчение.
procedure Terminate; public;
Прерывавает поиск. Если поиск не происходит, то выбрасывается исклчение.
function Scaning: Boolean; public;
Если возвращает True, то компонент осуществляет поиск.
property Pause: Boolean; public;
Присваивание этому свойству True, приостанавливает поиск.
Присваивание этому свойству False, возобновляет поиск.
Статистика
property Stat_DateTimeBegin: TDateTime; public; - время начала поиска (*)property Stat_DateTimeEnd: TDateTime; public; - время окончания поиска (**)property Stat_ScaningTime: TDateTime; public; - время сканирования (**)property Stat_ScanedFiles: Integer; public; - количество найденных файлов
property Stat_ScanedDirs: Integer; public; - количество просмотренных директорий
(*) статистическая переменная доступны после начала поиска
(**) статистические переменные доступны после окончания поиска
unit FileFinder;
interfaceuses
Windows, SysUtils, Classes;
type
EFileFinderError = class(Exception);
TFileAttribute = (faArchive, faReadOnly, faHidden, faSystem,
faCompressed, faOffline, faTemporary);
TFileAttributes = setof TFileAttribute;
TScanDirs = (sdOther, sdCurrentDir, sdCurrentDrive, sdFixedDrives,
sdAllDrives, sdAllNetwork);
PFileInfo = ^TFileInfo;
TFileInfo = record
FileName: string;
FileSize: Longword;
Attributes: TFileAttributes;
CreationTime: TDateTime;
ModifyTime: TDateTime;
LastAccessTime: TDateTime;
end;
TFindFileEvent = procedure(Sender: TObject; var FileInfo: TFileInfo) ofobject;
TScanDirEvent = procedure(Sender: TObject; const Dir: string) ofobject;
TEndScanEvent = procedure(Sender: TObject; Terminated: Boolean) ofobject;
TCustomFileFinder = class(TComponent)
private
FThrManager: Pointer;
FScanDirs: TScanDirs;
FDirs: TStrings;
FWildcards: TStrings;
FRecurse: Boolean;
FAttributes: TFileAttributes;
FMaxThreads: Cardinal;
FOnFindFile: TFindFileEvent;
FOnScanDir: TScanDirEvent;
FOnEndScan: TEndScanEvent;
FStat_BeginTime: TDateTime;
FStat_EndTime: TDateTime;
FStat_IncTime: TDateTime;
FStat_BegScan: TDateTime;
FStat_NumFiles: Integer;
FStat_NumDirs: Integer;
function GetPause: Boolean;
procedure SetPause(Value: Boolean);
procedure SetDirs(Value: TStrings);
procedure SetScanDirs(Value: TScanDirs);
procedure SetWildcards(Value: TStrings);
procedure SetRecurse(Value: Boolean);
procedure SetAttributes(Value: TFileAttributes);
procedure SetMaxThreads(Value: Cardinal);
procedure FindFileCB(var FileInfo: TFileInfo);
procedure ScanDirCB(const Dir: string);
procedure TMTerminated;
function GetStat_DateTimeBegin: TDateTime;
function GetStat_DateTimeEnd: TDateTime;
function GetStat_ScaningTime: TDateTime;
protectedprocedure DoFindFile(var FileInfo: TFileInfo); virtual;
procedure DoScanDir(const Dir: string); virtual;
property Dirs: TStrings read FDirs write SetDirs;
property ScanDirs: TScanDirs read FScanDirs write SetScanDirs;
property Wildcards: TStrings read FWildcards write SetWildcards;
property Recurse: Boolean read FRecurse write SetRecurse default TRUE;
property Attributes: TFileAttributes read FAttributes write SetAttributes;
property MaxThreads: Cardinal read FMaxThreads write SetMaxThreads;
property OnFindFile: TFindFileEvent read FOnFindFile write FOnFindFile;
property OnScanDirectory: TScanDirEvent read FOnScanDir write FOnScanDir;
property OnEndScan: TEndScanEvent read FOnEndScan write FOnEndScan;
publicconstructor Create(Owner: TComponent); override;
destructor Destroy; override;
procedure Start(Wait: Boolean = False);
procedure Terminate;
function Scaning: Boolean;
property Pause: Boolean read GetPause write SetPause;
property Stat_DateTimeBegin: TDateTime read GetStat_DateTimeBegin;
property Stat_DateTimeEnd: TDateTime read GetStat_DateTimeEnd;
property Stat_ScaningTime: TDateTime read GetStat_ScaningTime;
property Stat_ScanedFiles: Integer read FStat_NumFiles;
property Stat_ScanedDirs: Integer read FStat_NumDirs;
end;
TFileFinder = class(TCustomFileFinder)
publishedproperty Dirs;
property ScanDirs;
property Wildcards;
property Recurse;
property Attributes;
property MaxThreads;
property OnFindFile;
property OnScanDirectory;
property OnEndScan;
end;
procedureregister;
implementationtype
PQueueRecord = ^TQueueRecord;
TQueueRecord = record
Dir: string;
Thread: Pointer;
end;
TThreadManager = classprivate
FWildcards: arrayofstring;
FTerminated: Boolean;
FFF: TCustomFileFinder;
ThreadList: TThreadList;
TermEvent: THandle;
FQueue: TThreadList;
constructor Create(AFF: TCustomFileFinder);
destructor Destroy; override;
function GetDir(Sender: TObject): string;
procedure AddDir(const Dir: string);
procedure ExamineAndStart;
procedure Terminate;
procedure Suspend;
procedure Resume;
procedure WaitForAll;
function GetSuspended: Boolean;
procedure FFTTerminated(Sender: TObject);
end;
TFileFinderThread = class(TThread)
private
ThrManager: TThreadManager;
FilesInfo: arrayof TFileInfo;
Bounds: arrayof Integer;
FilesCount: Integer;
CurFileInfo: PFileInfo;
CurrentDir: string;
ProcFileName: string;
ProcFileAttr: Cardinal;
NetRes: TNetResource;
ServerProc: string;
procedure EnumNetRes(Ptr: PNetResource);
function PartNetworkPath(const Dir: string): Boolean;
function TestFile(var ft: TFileAttributes): Boolean;
procedure WildcardProc(const Wildcard: string);
procedure DirProc(const Dir: string);
function SubSearch(Low, High: Integer): Boolean;
function SearchFile: Boolean;
procedure IncFilesCount;
procedure SafeCallFind;
procedure SafeCallNotify;
protectedprocedure DoTerminate; override;
procedure Execute; override;
publicconstructor Create(ATM: TThreadManager);
end;
resourcestring
NamePalette = 'Tadex''s Components';
ScaningProcessError = 'Scaning in progress. Can not change this parameter.';
ProcThreadError = 'Scaning don''t started';
BeginScaningError = 'Scaning already in progress.';
StatNotCollected = 'This statistic information isn''t collected yet';
function DrivePath(Letter: char): string;
begin
Result := Letter + ':\';
end;
function MakePath(const Path, FileName: string): string;
beginif Path[Length(Path)] = '\' then
Result := Concat(Path, FileName)
else
Result := Concat(Path, '\', FileName);
end;
function ExtractServerName(const UNCPath: string): string;
var
DelimPos: Integer;
begin
Result := '.';
if (UNCPath[1] <> '\') or (UNCPath[2] <> '\') then
Exit;
Result := Copy(UNCPath, 3, Length(UNCPath) - 2);
DelimPos := Pos('\', Result);
if DelimPos > 0 then
Result := Copy(Result, 1, DelimPos - 1);
if Result = '' then
Result := '*';
end;
function ExpandPath(const Path: string): string;
var
Dir, Drive, name: string;
i, Count: Integer;
Dirs: array [0..127] ofstring;
Buffer: array [0..MAX_PATH - 1] of Char;
FName: PChar;
FD: WIN32_FIND_DATA;
HDir: THandle;
NxtFile: Boolean;
begin
Result := '';
SetString(Dir, Buffer, GetFullPathName(PChar(Path),
SizeOf(Buffer), Buffer, FName));
Drive := ExtractFileDrive(Dir);
Count := 0;
for i := Low(Dirs) to High(Dirs) dobeginif (Length(Dir) = 3) or (Length(Dir) = Length(Drive)) then
Break;
name := ExtractFileName(Dir);
Dir := ExtractFileDir(Dir);
ifname <> '' thenbegin
Dirs[Count] := name;
Inc(Count);
end;
end;
if Count > 0 then
Dir := Drive;
name := UpperCase(Dir);
for i := Count - 1 downto 0 dobegin
Dir := Concat(Dir, '\', Dirs[i]);
HDir := FindFirstFile(PChar(Dir), FD);
if HDir = INVALID_HANDLE_VALUE then
Exit;
try
NxtFile := FindNextFile(HDir, FD);
finally
Windows.FindClose(HDir);
end;
if NxtFile then
Exit;
if FD.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
Exit;
name := Concat(name, '\', FD.cFileName);
end;
Result := name;
end;
function FT2DT(FileTime: TFileTime): TDateTime;
var
LocalFileTime: TFileTime;
Tmp: Int64;
begin
FileTimeToLocalFileTime(FileTime, LocalFileTime);
with Int64Rec(Tmp), LocalFileTime dobegin
Hi := dwHighDateTime;
Lo := dwLowDateTime;
end;
Result := (Tmp - 94353120000000000) / 8.64e11;
end;
function LowBound(Arr: arrayof Integer; index: Integer): Integer;
beginifindex = 0 then
Result := 0
else
Result := Arr[index - 1];
end;
constructor TFileFinderThread.Create(ATM: TThreadManager);
begininherited Create(True);
FreeOnTerminate := True;
ThrManager := ATM;
SetLength(Bounds, Length(ThrManager.FWildcards));
SetLength(FilesInfo, 8);
ServerProc := '';
with NetRes dobegin
dwScope := RESOURCE_GLOBALNET;
dwType := RESOURCETYPE_DISK;
dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;
dwUsage := RESOURCEUSAGE_CONTAINER;
lpLocalName := '';
lpComment := '';
lpProvider := '';
end;
end;
procedure TFileFinderThread.SafeCallFind;
begin
ThrManager.FFF.FindFileCB(CurFileInfo^);
end;
procedure TFileFinderThread.SafeCallNotify;
begin
ThrManager.FFF.ScanDirCB(CurrentDir);
end;
function TFileFinderThread.SubSearch(Low, High: Integer): Boolean;
var
Tmp: Integer;
begin
Tmp := High - Low;
if Tmp <= 0 then
Result := False
elseif Tmp = 1 then
Result := FilesInfo[Low].FileName = ProcFileName
elsebegin
Tmp := Low + Tmp div 2;
if FilesInfo[Tmp].FileName <= ProcFileName then
Result := SubSearch(Tmp, High)
else
Result := SubSearch(Low, Tmp);
end;
end;
function TFileFinderThread.SearchFile: Boolean;
var
i: Integer;
begin
Result := True;
for i := 0 to High(Bounds) doif SubSearch(LowBound(Bounds, i), Bounds[i]) then
Exit;
Result := False;
end;
function TFileFinderThread.TestFile(var FT: TFileAttributes): Boolean;
begin
Result := False;
FT := [];
if ProcFileAttr and FILE_ATTRIBUTE_DIRECTORY <> 0 then
Exit;
if ProcFileAttr and FILE_ATTRIBUTE_ARCHIVE <> 0 then
Include(FT, faArchive);
if ProcFileAttr and FILE_ATTRIBUTE_READONLY <> 0 then
Include(FT, faReadOnly);
if ProcFileAttr and FILE_ATTRIBUTE_HIDDEN <> 0 then
Include(FT, faHidden);
if ProcFileAttr and FILE_ATTRIBUTE_SYSTEM <> 0 then
Include(FT, faSystem);
if ProcFileAttr and FILE_ATTRIBUTE_COMPRESSED <> 0 then
Include(FT, faCompressed);
if ProcFileAttr and FILE_ATTRIBUTE_TEMPORARY <> 0 then
Include(FT, faTemporary);
if ProcFileAttr and FILE_ATTRIBUTE_OFFLINE <> 0 then
Include(FT, faOffline);
Result := ((FT * ThrManager.FFF.FAttributes <> [])
or (FT = [])) andnot SearchFile;
end;
procedure TFileFinderThread.IncFilesCount;
begin
Inc(FilesCount);
if FilesCount >= Length(FilesInfo) then
SetLength(FilesInfo, Length(FilesInfo) * 3 div 2);
end;
procedure TFileFinderThread.WildcardProc(const Wildcard: string);
var
FD: WIN32_FIND_DATA;
Files: THandle;
Attr: TFileAttributes;
beginif Terminated then
Exit;
Files := FindFirstFile(PChar(Wildcard), FD);
if Files <> INVALID_HANDLE_VALUE thentryrepeat
ProcFileName := FD.cFileName;
ProcFileAttr := FD.dwFileAttributes;
if TestFile(Attr) thenwith FilesInfo[FilesCount], FD dobegin
FileName := ProcFileName;
FileSize := nFileSizeLow;
Attributes := Attr;
CreationTime := FT2DT(ftCreationTime);
ModifyTime := FT2DT(ftLastWriteTime);
LastAccessTime := FT2DT(ftLastAccessTime);
IncFilesCount;
enduntil
Terminated ornot FindNextFile(Files, FD)
finally
Windows.FindClose(Files);
endend;
procedure TFileFinderThread.EnumNetRes(Ptr: PNetResource);
type
PNetResArray = ^TNetResArray;
TNetResArray = array[0..MaxInt div sizeof(TNetResource) - 1] of TNetResource;
var
I, BufSize, NetResult: Integer;
Count, Size: LongWord;
NetHandle: THandle;
NetResources: PNetResArray;
beginif Terminated then
Exit;
if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
0, Ptr, NetHandle) <> NO_ERROR then
Exit;
NetResources := nil;
try
BufSize := 10 * SizeOf(TNetResource);
GetMem(NetResources, BufSize);
repeat
Count := $FFFFFFFF; Size := BufSize;
NetResult := WNetEnumResource(NetHandle, Count, NetResources, Size);
if NetResult <> ERROR_MORE_DATA then
Break;
BufSize := Size;
ReallocMem(NetResources, BufSize);
until
False;
if NetResult = NO_ERROR thenfor I := 0 to Count - 1 dowith NetResources^[I] doif dwDisplayType in [RESOURCEDISPLAYTYPE_SHARE,
RESOURCEDISPLAYTYPE_SERVER] then
ThrManager.AddDir(lpRemoteName)
elseif (dwUsage and RESOURCEUSAGE_CONTAINER) =
RESOURCEUSAGE_CONTAINER then
EnumNetRes(@NetResources^[I]);
finallyif NetResources <> nilthen
FreeMem(NetResources);
WNetCloseEnum(NetHandle);
end;
end;
function TFileFinderThread.PartNetworkPath(const Dir: string): Boolean;
begin
Result := False;
if (Length(Dir) < 2) or (Dir[1] <> '\') or (Dir[2] <> '\') then
Exit;
if (Length(Dir) > 2) and (LastDelimiter('\', Dir) > 2) then
Exit;
if Length(Dir) = 2 then
EnumNetRes(nil)
elsebegin
NetRes.lpRemoteName := PChar(Dir);
EnumNetRes(@NetRes);
end;
Result := True;
end;
procedure TFileFinderThread.DirProc(const Dir: string);
var
FD: WIN32_FIND_DATA;
Dirs: THandle;
i: Integer;
beginif Terminated then
Exit;
CurrentDir := Dir;
Synchronize(SafeCallNotify);
if PartNetworkPath(Dir) then
Exit;
FilesCount := 0;
for i := 0 to High(Bounds) do
Bounds[i] := -1;
for i := 0 to High(ThrManager.FWildcards) dobegin
WildcardProc(MakePath(Dir, ThrManager.FWildcards[i]));
Bounds[i] := FilesCount;
end;
for i := 0 to FilesCount - 1 dobeginif Terminated then
Exit;
CurFileInfo := @FilesInfo[i];
with CurFileInfo^ dobegin
FileName := MakePath(Dir, FileName);
Synchronize(SafeCallFind);
FileName := '';
end;
end;
if ThrManager.FFF.FRecurse andnot Terminated thenbegin
Dirs := FindFirstFile(PChar(MakePath(Dir, '*.*')), FD);
if Dirs <> INVALID_HANDLE_VALUE thentryrepeatwith FD doif ((dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) and
(cFileName <> string('.')) and (cFileName <> string('..')) then
DirProc(MakePath(Dir, cFileName));
until
Terminated ornot FindNextFile(Dirs, FD);
finally
Windows.FindClose(Dirs);
endendend;
procedure TFileFinderThread.Execute;
var
Dir: string;
beginrepeat
Dir := ThrManager.GetDir(Self);
if Dir = '' then
Break;
DirProc(Dir);
until
Terminated;
end;
procedure TFileFinderThread.DoTerminate;
begin
ThrManager.FFTTerminated(Self);
end;
constructor TThreadManager.Create(AFF: TCustomFileFinder);
var
i, j, Count: Integer;
ch: Char;
Dirs: arrayofstring;
begininherited Create;
FFF := AFF;
FTerminated := False;
FQueue := TThreadList.Create;
ThreadList := TThreadList.Create;
TermEvent := CreateEvent(nil, False, False, nil);
SetLength(FWildcards, FFF.Wildcards.Count);
Count := 0;
for i := 0 to High(FWildcards) doif Trim(FFF.Wildcards.Strings[i]) <> '' thenbegin
FWildcards[Count] := FFF.Wildcards.Strings[i];
Inc(Count);
end;
SetLength(FWildcards, Count);
SetLength(Dirs, FFF.FDirs.Count);
for i := 0 to High(Dirs) do
Dirs[Count] := FFF.FDirs.Strings[i];
case FFF.FScanDirs of
sdOther:
beginfor i := 0 to High(Dirs) do
Dirs[i] := ExpandPath(Dirs[i]);
for i := 0 to High(Dirs) dofor j := 0 to High(Dirs) doif (i <> j) and (Dirs[i] <> '') and (Dirs[j] <> '') thenif FFF.FRecurse thenbeginif Pos(Dirs[j], Dirs[i]) > 0 then
Dirs[i] := '';
endelsebeginif Dirs[i] = Dirs[j] then
Dirs[i] := '';
end;
for i := 0 to High(Dirs) doif Dirs[i] <> '' then
AddDir(Dirs[i]);
end;
sdCurrentDir:
AddDir(GetCurrentDir);
sdCurrentDrive:
AddDir(DrivePath(GetCurrentDir[1]));
sdAllNetwork:
AddDir('\\');
elsefor ch := 'A' to 'Z' docase GetDriveType(PChar(DrivePath(ch))) of
DRIVE_REMOVABLE, DRIVE_REMOTE, DRIVE_CDROM:
if FFF.FScanDirs = sdAllDrives then
AddDir(DrivePath(ch));
DRIVE_FIXED:
if FFF.FScanDirs in [sdAllDrives, sdFixedDrives] then
AddDir(DrivePath(ch));
end;
end;
end;
destructor TThreadManager.Destroy;
begin
Terminate;
WaitForAll;
CloseHandle(TermEvent);
ThreadList.Free;
FQueue.Free;
inherited Destroy;
end;
procedure TThreadManager.Terminate;
var
List: TList;
i: Integer;
begin
FTerminated := True;
List := ThreadList.LockList;
for i := 0 to List.Count - 1 dowith TFileFinderThread(List.Items[i]) dobegin
Suspended := False;
Terminate;
end;
ThreadList.UnlockList;
end;
procedure TThreadManager.Suspend;
var
List: TList;
i: Integer;
begin
List := ThreadList.LockList;
for i := 0 to List.Count - 1 do
TFileFinderThread(List.Items[i]).Suspended := True;
ThreadList.UnlockList;
end;
procedure TThreadManager.Resume;
var
List: TList;
i: Integer;
begin
List := ThreadList.LockList;
for i := 0 to List.Count - 1 do
TFileFinderThread(List.Items[i]).Suspended := False;
ThreadList.UnlockList;
end;
procedure TThreadManager.WaitForAll;
var
Msg: TMsg;
H: THandle;
begin
H := TermEvent;
if GetCurrentThreadID = MainThreadID thenwhile MsgWaitForMultipleObjects(1, H, False, INFINITE,
QS_SENDMESSAGE) = WAIT_OBJECT_0 + 1 do
PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
else
WaitForSingleObject(H, INFINITE);
end;
procedure TThreadManager.FFTTerminated(Sender: TObject);
var
List: TList;
Termination: Boolean;
begin
ThreadList.Remove(Sender);
ExamineAndStart;
List := ThreadList.LockList;
Termination := List.Count = 0;
ThreadList.UnlockList;
if Termination thenbegin
SetEvent(TermEvent);
FFF.TMTerminated;
end;
end;
function TThreadManager.GetSuspended: Boolean;
var
List: TList;
i: Integer;
begin
Result := False;
List := ThreadList.LockList;
for i := 0 to List.Count - 1 do
Result := Result or TFileFinderThread(List.Items[i]).Suspended;
ThreadList.UnlockList;
end;
function TThreadManager.GetDir(Sender: TObject): string;
var
List: TList;
i: Integer;
ServerProc: string;
begin
Result := '';
List := FQueue.LockList;
for i := 0 to List.Count - 1 dowith PQueueRecord(List.Items[i])^ doif Thread = Sender thenbegin
Result := Dir;
Dispose(List.Items[i]);
List.Delete(i);
Break;
end;
if Result = '' thenbegin
ServerProc := '';
for i := 0 to List.Count - 1 dowith PQueueRecord(List.Items[i])^ doif Thread = nilthenbegin
ServerProc := ExtractServerName(Dir);
Result := Dir;
Dispose(List.Items[i]);
List.Delete(i);
Break;
end;
if ServerProc <> '' thenbeginif Sender is TFileFinderThread then
TFileFinderThread(Sender).ServerProc := ServerProc;
for i := 0 to List.Count - 1 dowith PQueueRecord(List.Items[i])^ doif ExtractServerName(Dir) = ServerProc then
Thread := Sender;
end;
end;
FQueue.UnlockList;
end;
procedure TThreadManager.AddDir(const Dir: string);
var
i: Integer;
List: TList;
QRec: PQueueRecord;
Caller: TFileFinderThread;
ServerProc: string;
begin
ServerProc := ExtractServerName(Dir);
Caller := nil;
List := ThreadList.LockList;
for i := 0 to List.Count - 1 doif TFileFinderThread(List.Items[i]).ServerProc = ServerProc thenbegin
Caller := TFileFinderThread(List.Items[i]);
Break;
end;
ThreadList.UnlockList;
New(QRec);
QRec.Dir := Dir;
QRec.Thread := Caller;
FQueue.Add(QRec);
ExamineAndStart;
end;
procedure TThreadManager.ExamineAndStart;
var
Threads, Queue: TList;
i: Integer;
NewThread: TFileFinderThread;
ServerProc: string;
beginif FTerminated then
Exit;
Threads := ThreadList.LockList;
Queue := FQueue.LockList;
repeat
ServerProc := '';
if (FFF.FMaxThreads = 0) or (Cardinal(Threads.Count) < FFF.FMaxThreads) thenbeginfor i := 0 to Queue.Count - 1 dowith PQueueRecord(Queue.Items[i])^ doif Thread = nilthenbegin
ServerProc := ExtractServerName(Dir);
Break;
end;
if ServerProc <> '' thenbegin
NewThread := TFileFinderThread.Create(Self);
Threads.Add(NewThread);
NewThread.ServerProc := ServerProc;
for i := 0 to Queue.Count - 1 dowith PQueueRecord(Queue.Items[i])^ doif ExtractServerName(Dir) = ServerProc then
Thread := NewThread;
NewThread.Resume;
end;
end;
until
ServerProc = '';
FQueue.UnlockList;
ThreadList.UnlockList;
end;
constructor TCustomFileFinder.Create(Owner: TComponent);
begininherited Create(Owner);
FDirs := TStringList.Create;
FWildcards := TStringList.Create;
FAttributes := [faArchive, faReadOnly];
FRecurse := True;
FScanDirs := sdFixedDrives;
FMaxThreads := 10;
FThrManager := nil;
FWildcards.Add('*.*');
FStat_BeginTime := 0;
FStat_EndTime := 0;
FStat_IncTime := 0;
FStat_NumFiles := 0;
FStat_NumDirs := 0;
end;
destructor TCustomFileFinder.Destroy;
beginif Assigned(FThrManager) then
TThreadManager(FThrManager).Free;
FDirs.Free;
FWildcards.Free;
inherited Destroy;
end;
procedure TCustomFileFinder.FindFileCB(var FileInfo: TFileInfo);
begin
Inc(FStat_NumFiles);
DoFindFile(FileInfo);
end;
procedure TCustomFileFinder.ScanDirCB(const Dir: string);
begin
Inc(FStat_NumDirs);
DoScanDir(Dir);
end;
procedure TCustomFileFinder.DoFindFile(var FileInfo: TFileInfo);
beginif Assigned(FOnFindFile) then
FOnFindFile(self, FileInfo);
end;
procedure TCustomFileFinder.DoScanDir(const Dir: string);
beginif Assigned(FOnScanDir) then
FOnScanDir(self, Dir);
end;
function TCustomFileFinder.Scaning: Boolean;
begin
Result := Assigned(FThrManager);
end;
procedure TCustomFileFinder.SetDirs(Value: TStrings);
beginif Assigned(FThrManager) thenraise EFileFinderError.Create(ScaningProcessError);
FDirs.Assign(Value);
FScanDirs := sdOther;
end;
procedure TCustomFileFinder.SetWildcards(Value: TStrings);
beginif Assigned(FThrManager) thenraise EFileFinderError.Create(ScaningProcessError);
FWildcards.Assign(Value);
end;
procedure TCustomFileFinder.SetScanDirs(Value: TScanDirs);
beginif Assigned(FThrManager) thenraise EFileFinderError.Create(ScaningProcessError);
FScanDirs := Value;
end;
procedure TCustomFileFinder.SetRecurse(Value: Boolean);
beginif Assigned(FThrManager) thenraise EFileFinderError.Create(ScaningProcessError);
FRecurse := Value;
end;
procedure TCustomFileFinder.SetAttributes(Value: TFileAttributes);
beginif Assigned(FThrManager) thenraise EFileFinderError.Create(ScaningProcessError);
FAttributes := Value;
end;
procedure TCustomFileFinder.SetMaxThreads(Value: Cardinal);
begin
FMaxThreads := Value;
end;
procedure TCustomFileFinder.Terminate;
beginifnot Assigned(FThrManager) thenraise EFileFinderError.Create(ProcThreadError);
TThreadManager(FThrManager).Terminate;
end;
function TCustomFileFinder.GetPause: Boolean;
beginifnot Assigned(FThrManager) thenraise EFileFinderError.Create(ProcThreadError);
Result := TThreadManager(FThrManager).GetSuspended;
end;
procedure TCustomFileFinder.SetPause(Value: Boolean);
var
Suspended: Boolean;
beginifnot Assigned(FThrManager) thenraise EFileFinderError.Create(ProcThreadError);
Suspended := TThreadManager(FThrManager).GetSuspended;
ifnot Suspended and Value thenbegin
TThreadManager(FThrManager).Suspend;
FStat_IncTime := FStat_IncTime + (Now - FStat_BegScan);
end;
if Suspended andnot Value thenbegin
FStat_BegScan := Now;
TThreadManager(FThrManager).Resume;
end;
end;
procedure TCustomFileFinder.Start(Wait: Boolean);
beginif Assigned(FThrManager) thenraise EFileFinderError.Create(BeginScaningError);
FStat_BeginTime := Now;
FStat_BegScan := FStat_BeginTime;
FStat_IncTime := 0;
FStat_NumFiles := 0;
FStat_NumDirs := 0;
FThrManager := TThreadManager.Create(Self);
if Wait then
TThreadManager(FThrManager).WaitForAll;
end;
procedure TCustomFileFinder.TMTerminated;
var
Tmp: Boolean;
begin
Tmp := TThreadManager(FThrManager).FTerminated;
FreeAndNil(FThrManager);
FStat_EndTime := Now;
FStat_IncTime := FStat_IncTime + (FStat_EndTime - FStat_BegScan);
if Assigned(FOnEndScan) then
FOnEndScan(self, Tmp);
end;
function TCustomFileFinder.GetStat_DateTimeBegin: TDateTime;
beginif FStat_BeginTime = 0 thenraise EFileFinderError.Create(StatNotCollected);
Result := FStat_BeginTime;
end;
function TCustomFileFinder.GetStat_DateTimeEnd: TDateTime;
beginif (FStat_EndTime = 0) or Assigned(FThrManager) thenraise EFileFinderError.Create(StatNotCollected);
Result := FStat_EndTime;
end;
function TCustomFileFinder.GetStat_ScaningTime: TDateTime;
begin
Result := FStat_IncTime;
if Assigned(FThrManager) andnot
TThreadManager(FThrManager).GetSuspended then
Result := Result + (Now - FStat_BegScan);
end;
procedureregister;
begin
RegisterComponents(NamePalette, [TFileFinder]);
end;
end.
Это исходный код Delphi для компонента поиска файлов, использующего несколько потоков для поиска файлов и директорий в файловой системе. Компонент позволяет указать список директорий и wildcard'ы для поиска, а также атрибуты, такие как рекурсивный поиск и максимальное количество потоков.
Компоненты:
TFileFinder: Основной компонент, предоставляющий функциональность поиска файлов.
TThreadManager: отдельный компонент, управляющий потоками для поиска.
TCustomFileFinder: Абстрактная класс, предоставляющая общую функциональность для обоих компонентов TFileFinder и TThreadManager.
Код определяет несколько процедур и функций для выполнения различных задач:
Start(): Начинает процесс поиска файлов.
Terminate(): Останавливает процесс поиска файлов.
GetStat_...(): Возвращает статистику о процессе поиска,such as start and end times, scan time и т.д.
SetDirs(), SetWildcards(), SetScanDirs(), SetRecurse(), SetAttributes(), SetMaxThreads(): Устанавливает различные параметры для процесса поиска файлов.
Код также определяет несколько событий, которые могут быть триггерованы во время процесса поиска:
OnFindFile(): Триггерируется при обнаружении файла.
OnScanDir(): Триггерируется при сканировании директории.
OnEndScan(): Триггерируется при завершении процесса поиска.
В целом, этот код предоставляет гибкую и настраиваемую возможность для поиска файлов и директорий в файловой системе с использованием нескольких потоков.
This is a comprehensive and complex implementation of a file finder component in Delphi, including threads for parallel scanning, event-driven notifications, and statistics tracking.
Here's a high-level overview of the components:
1. `TCustomFileFinder`
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.