Function FindPicture(dstDir:String):Boolean;
var
hFindFile:Cardinal;
tfile,Ext,MainName:String;
FindFileData:WIN32_FIND_DATA;
begin
ChDir(dstDir);
hFindFile:=FindFirstFile('*.*',FindFileData);
if hFindFile<>INVALID_HANDLE_VALUE then
begin
repeat
tfile:=FindFileData.cFileName;
if (tfile='.') or (tfile='..') then
Continue;
if (FindFileData.dwFileAttributes=FILE_ATTRIBUTE_DIRECTORY) Then
Begin
if dstDir[Length(dstDir)]<>'\' then
FindPicture(dstDir+'\'+tfile)
else
FindPicture(dstDir+tfile);
End
else
Begin
//Mainform.ResultMemo.Lines.Add(tfile);
//在这里加入你要处理的代码
End
until FindNextFile(hFindFile,FindFileData)=False;
Windows.FindClose(hFindFile);
end;
Result:=True;
End;
procedure SearchNext(MyStr : String; MyAttr : Integer);
var
MyF : TSearchRec;
begin
if FindFirst(MyStr+'*.*', MyAttr, MyF) = 0 then
begin
If ((MyF.Attr And faDirectory)=$00000010) and
(MyF.Name <> '..') And (MyF.Name <> '.') then
begin
SearchNext(MyStr+MyF.Name+'\', MyAttr);
end;
if (MyF.Name <> '..') And (MyF.Name <> '.') then
begin
//****要处理的事件 ExecuteFile(MyStr+MyF.Name);
end;
While FindNext(MyF)=0 do
begin
If ((MyF.Attr And faDirectory)=$00000010) and
(MyF.Name <> '..') And (MyF.Name <> '.') then
begin
SearchNext(MyStr+MyF.Name+'\', MyAttr);
end;
if ((MyF.Attr And faDirectory)<>$00000010) and
(MyF.Name <> '..') And (MyF.Name <> '.') then
begin
//****要处理的事件 ExecuteFile(MyStr+MyF.Name);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm_Main.Button5Click(Sender: TObject);
var TargetDateTime: TDateTime;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure SetDirFileTime(DirName:string);
var DirInfo: TSearchRec;
DosError: Integer;
begin
DosError := FindFirst(DirName+'\*.*', FaAnyfile, DirInfo);
while DosError=0 do
begin
if ((DirInfo.Attr and FaDirectory)=faDirectory) and (DirInfo.Name<>'.') and (DirInfo.Name<>'..')
then SetDirFileTime(DirName + '\' + DirInfo.Name);
{$IF DEFINED(WIN32) AND DECLARED(UsingVCL)}
if ((DirInfo.Attr and FaDirectory)<>FaDirectory) and ((DirInfo.Attr and FaVolumeID)<>FaVolumeID)
{$ELSE}
if ((DirInfo.Attr and FaDirectory)<>FaDirectory)
{$IFEND}
then if (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,4)=ReverseStr('.DDP'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,4)=ReverseStr('.BAK'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,4)=ReverseStr('.TMP'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,4)=ReverseStr('.LOG'))
//or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,4)=ReverseStr('.DCU'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,5)=ReverseStr('.~PAS'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,5)=ReverseStr('.~DFM'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,5)=ReverseStr('.EML'))
or (Copy(ReverseStr(UpperCase(DirInfo.Name)),1,3)=ReverseStr('.MB'))
then DeleteFile(pChar(DirName + '\' + DirInfo.Name))
else begin
Memo.Lines.Add(DirName + '\' + DirInfo.Name);
try SetFileDateTime(DirName + '\' + DirInfo.Name,TargetDateTime) except end;
end;
DosError := FindNext(DirInfo);
end;
SysUtils.FindClose(DirInfo);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
TargetDateTime := Date;
Memo.Lines.Clear;
SetDirFileTime(TargetDir);
end;
type
TForm1 = class(TForm)
DriveComboBox1: TDriveComboBox;
DirectoryListBox1: TDirectoryListBox;
Edit1: TEdit;
lbFiles: TListBox;
SearchForFiles: TButton;
Edit2: TEdit;
procedure SearchForFilesClick(Sender: TObject);
procedure lbFilesClick(Sender: TObject);
private
{ Private declarations }
FFileName:string;
Function GetDirectoryName(Dir:string):string;
procedure FindFiles(APath:string);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FindFiles(APath: string);
var
FsearchRec,
DsearchRec:TSearchRec;
FindResult:integer;
function IsDirNotation(ADirName:string):Boolean;
begin
Result:=(ADirName='.') or (ADirName='..');
end;
begin
APath:=GetDirectoryName(APath);
FindResult:=FindFirst(APath+FFileName,faAnyFile+faHidden+faSysFile+faReadOnly,FsearchRec);
try
while FindResult=0 do
begin
lbFiles.Items.Add(LowerCase(APath+FsearchRec.Name));
FindResult:=FindNext(FSearchRec);
end;
while FindResult=0 do
begin
if ((DsearchRec.Attr and faDirectory)=faDirectory) and Not IsDirNotation(DsearchRec.Name) then
FindFiles(APath+DsearchRec.Name);
FindResult:=FindNext(DSearchRec);
end;
finally
FindClose(FSearchRec);
end;
end;
function TForm1.GetDirectoryName(Dir: string): string;
begin
if Dir[Length(Dir)]<>'\' then
Result:=Dir+'\'
else
Result:=Dir;
end;