unit tSearchFiles;
interface
uses
Classes, Windows, dialogs;
type
TArrayofStringList =
packed array of TStringList;
TtSearchFiles =
class(TThread)
private
iDirCount : Integer;
protected
procedure Execute;
override;
procedure GetFiles(
const Directory :
string;
var Files : TArrayofStringList;
(*type TArrayofStringList = packed array of TStringList;*)
const FileMask :
string = '
*.*';
const SubFolders : Boolean = True);
public
sDir :
String;
// wird übergeben vom Haupt code
FileList : TArrayofStringList;
// wird übergeben vom Haupt code
end;
implementation
uses
Sysutils, MainFrame;
{ TSearchFiles }
///////////////////////////GetFiles/////////////////////////////////////////////
// Autor: Daniel B
// Editor: C.Schoch
////////////////////////////////////////////////////////////////////////////////
procedure tTSearchFiles.GetFiles(
const Directory :
string;
var Files : TArrayofStringList;
const FileMask :
string = '
*.*';
const SubFolders : Boolean = True);
function SlashSep(
const Path, S :
string):
string;
// Backslash zum Pfadende hinzufügen wenn keiner vorhanden
begin
if AnsiLastChar(Path)^ <> '
\'
then
Result := Path + '
\' + S
else
Result := Path + S;
end;
var
SearchRec : TSearchRec;
begin
// Verzeichniss nach Dateien durchsuchen
SetLength(Files,iDirCount+1);
// hier set length
Files[iDirCount] := TStringList.Create;
if FindFirst(SlashSep(Directory, FileMask),
faAnyFile - faDirectory - faVolumeID, SearchRec) = 0
then
begin
if not Terminated
then
begin
try
repeat
Files[iDirCount].Add(SlashSep(Directory, SearchRec.
Name));
until
(FindNext(SearchRec) <> 0)
or Terminated;
finally
SysUtils.FindClose(SearchRec);
end;
end;
end;
if SubFolders
and not Terminated
then
begin
// Unterordner suchen
inc(iDirCount);
if FindFirst(SlashSep(Directory,'
*.*'), faAnyFile, SearchRec) = 0
then
begin
try
repeat
if (SearchRec.Attr
and faDirectory) <> 0
then
begin
if ((SearchRec.
Name <> '
.')
and (SearchRec.
Name <> '
..'))
then
begin
GetFiles(SlashSep(Directory, SearchRec.
Name),Files,FileMask, SubFolders);
end;
end;
until
FindNext(SearchRec) <> 0;
finally
SysUtils.FindClose(SearchRec);
end;
end;
end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure TtSearchFiles.Execute;
begin
iDirCount := 0;
MainForm.test1 := true;
GetFiles(sDir, FileList, '
*.*', true);
MainForm.test1:= false;
end;
end.