unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Windows,
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls;
type
TStrArr =
array of string;
{ TForm1 }
TForm1 =
class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
ListBox1: TListBox;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
private
function MySearch(
const BasePath, BaseFolder:
string;
const FileMask:
string = '
*.*'): TStrArr;
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
procedure AddStrArr(
var AArr: TStrArr;
const AString:
string);
var
i: Integer;
begin
i := Length(AArr);
SetLength(AArr, Succ(i));
AArr[i] := AString;
end;
function GetAllFolders(
const BasePath:
string;
const IncludeSubFolders: Boolean = False): TStrArr;
var
FindExHandle : THandle;
Win32FindData : TWin32FindData;
FindExInfoLevels: TFINDEX_INFO_LEVELS;
FindExSearchOps : TFINDEX_SEARCH_OPS;
AdditionalFlags : DWORD;
i, ii : Integer;
tmp : TStrArr;
begin
SetLength(Result, 0);
FindExInfoLevels := FindExInfoBasic;
FindExSearchOps := FindExSearchLimitToDirectories;
AdditionalFlags := 0;
FindExHandle := Windows.FindFirstFileEx(PChar(IncludeTrailingBackslash(BasePath) + '
*.*')
,FindExInfoLevels
,@Win32FindData
,FindExSearchOps
,
nil
,AdditionalFlags);
if (FindExHandle <> INVALID_HANDLE_VALUE)
then
repeat
if ((Win32FindData.cFileName <> '
.')
and (Win32FindData.cFileName <> '
..')
and (0 <> (Win32FindData.dwFileAttributes
and FILE_ATTRIBUTE_DIRECTORY)))
then
AddStrArr(Result, IncludeTrailingBackslash(BasePath) + Win32FindData.cFileName);
until not Windows.FindNextFile(FindExHandle, Win32FindData);
Windows.FindClose(FindExHandle);
if IncludeSubFolders
then
for i := Low(Result)
to High(Result)
do
begin
tmp := GetAllFolders(Result[i], IncludeSubFolders);
for ii := Low(tmp)
to High(tmp)
do
AddStrArr(Result, tmp[ii]);
end;
SetLength(tmp, 0);
end;
function GetAllFiles(
const BaseFolder:
string;
const FileMask:
string = '
*.*'): TStrArr;
var
FindExHandle : THandle;
Win32FindData : TWin32FindData;
FindExInfoLevels: TFINDEX_INFO_LEVELS;
FindExSearchOps : TFINDEX_SEARCH_OPS;
AdditionalFlags : DWORD;
begin
SetLength(Result, 0);
FindExInfoLevels := FindExInfoBasic;
FindExSearchOps := FindExSearchLimitToDirectories;
AdditionalFlags := 0;
FindExHandle := Windows.FindFirstFileEx(PChar(IncludeTrailingBackslash(BaseFolder) + FileMask)
,FindExInfoLevels
,@Win32FindData
,FindExSearchOps
,
nil
,AdditionalFlags);
if (FindExHandle <> INVALID_HANDLE_VALUE)
then
repeat
if ((Win32FindData.cFileName <> '
.')
and (Win32FindData.cFileName <> '
..')
and (0 = (Win32FindData.dwFileAttributes
and FILE_ATTRIBUTE_DIRECTORY)))
then
AddStrArr(Result, IncludeTrailingBackslash(BaseFolder) + Win32FindData.cFileName);
until not Windows.FindNextFile(FindExHandle, Win32FindData);
Windows.FindClose(FindExHandle);
end;
{ TForm1 }
function TForm1.MySearch(
const BasePath, BaseFolder:
string;
const FileMask:
string = '
*.*'): TStrArr;
var
tmp, Folders, Files: TStrArr;
i,ii: Integer;
begin
SetLength(tmp, 0);
SetLength(Folders, 0);
SetLength(Files, 0);
tmp := GetAllFolders(BasePath, True);
// sieve out folders that match criteria
for i := Low(tmp)
to High(tmp)
do
if (Pos(UpperCase(BaseFolder), UpperCase(tmp[i])) <> 0)
then
AddStrArr(Folders, tmp[i]);
SetLength(tmp, 0);
// get files that matching criteria
for i := Low(Folders)
to High(Folders)
do
begin
tmp := GetAllFiles(Folders[i], FileMask);
for ii := Low(tmp)
to High(tmp)
do
AddStrArr(Files, tmp[ii]);
end;
Result := Files;
SetLength(tmp, 0);
SetLength(Folders, 0);
SetLength(Files, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
List: TStrArr;
begin
List := MySearch(Edit1.Text, Edit2.Text, Edit3.Text);
ListBox1.Items.BeginUpdate;
ListBox1.Clear;
for i := Low(List)
to High(List)
do
ListBox1.Items.Add(List[i]);
ListBox1.Items.EndUpdate;
end;
end.