unit unDirOption;
interface
uses SysUtils, Classes;
//查当前文件夹下的所有子文件
procedure SearchFile(DirName: String; var sList: TStrings);
//判断文件夹是否为空
function IsEmptyDir(sDir: String): Boolean;
//判断字符串是否为数字
function IsNumber(sStr: String): Boolean;
//删除文件夹
procedure DeleteDir(sDirectory: String);
{
执行删除文件夹操作
sFileName -> 要扫描的文件夹路径 sList -> 用至装载将扫描到的文件夹
iDay -> 区别是扫10个字符还是8个字符 （超速是8个，过往车辆是10个）
iAgoDay -> 要删除多少天前的记录
}
procedure ExecuteDeleteDir(Const sFileName: String; var sList: TStrings;
iDay, iAgoDay: Integer);
//遍历文件夹及子文件夹的文件
function MakeFileList(Path,FileExt:string):TStringList ;
var
MyFileName: string;
implementation
procedure SearchFile(DirName: String; var sList: TStrings);
Var
Found: integer;
SearchRec: TSearchRec;
begin
Found := FindFirst(DirName + ‘*.*‘,faAnyFile,searchrec);
while Found = 0 do
begin
if ((SearchRec.Attr and faDirectory)<>0) then //directory
begin
if(SearchRec.Name <> ‘.‘)and(SearchRec.Name <> ‘..‘) then
begin
SearchFile(DirName + SearchRec.Name + ‘\‘, sList);
MyFileName := DirName + SearchRec.Name;
sList.Insert(0, MyFileName);
end;
end;
Found := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;
procedure ExecuteDeleteDir(Const sFileName: String; var sList: TStrings;
iDay, iAgoDay: Integer);
var
I: Integer;
LastDir: String; //文件夹最后几个字符
DirDate: String;//当前文件夹的日期
begin
SearchFile(sFileName, sList);
for I := 0 to sList.Count - 1 do
begin
if iDay = 10 then
LastDir := copy(sList.Strings[i],length(sList.Strings[i])-9,10)
else LastDir := copy(sList.Strings[i],length(sList.Strings[i])-9,8);
if IsNumber(LastDir) then
begin
DirDate := copy(sList.Strings[i],length(sList.Strings[i])-9,8);
//此处将字符串转为日期格式
DirDate := Copy(DirDate,1,4) + ‘-‘ + Copy(DirDate,5,2) + ‘-‘ + Copy(DirDate,7,2);
if StrToDate(DirDate) < Date - iAgoDay then //进行条件筛选
begin
//判断文件夹是否为空
//if IsEmptyDir(sList.Strings[i]) then
DeleteDir(sList.Strings[i]);
end;
end;
end;
end;
function IsEmptyDir(sDir: String): Boolean;
var
sr: TsearchRec;
begin
Result := True;
if Copy(sDir, Length(sDir) - 1, 1) <> ‘\‘ then sDir := sDir + ‘\‘;
if FindFirst(sDir + ‘*.*‘, faAnyFile, sr) = 0 then
repeat
if (sr.Name <> ‘.‘) and (sr.Name <> ‘..‘) then
begin
Result := False;
break;
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
function IsNumber(sStr: String): Boolean;
var
i,iLength: integer;
begin
iLength := Length(sStr);
for i := 1 to iLength do
begin
if not (sStr[i] in [‘0‘..‘9‘]) then
begin
Result := false;
exit;
end
end;
Result := true;
end;
procedure DeleteDir(sDirectory: String);
//删除目录和目录下得所有文件和文件夹
var
sr: TSearchRec;
sPath,sFile: String;
begin
//检查目录名后面是否有 ‘\‘
if Copy(sDirectory,Length(sDirectory),1) <> ‘\‘ then
sPath := sDirectory + ‘\‘
else
sPath := sDirectory;
//------------------------------------------------------------------
if FindFirst(sPath+‘*.*‘,faAnyFile, sr) = 0 then
begin
repeat
sFile:=Trim(sr.Name);
if sFile=‘.‘ then Continue;
if sFile=‘..‘ then Continue;
sFile:=sPath+sr.Name;
if (sr.Attr and faDirectory)<>0 then
DeleteDir(sFile)
else if (sr.Attr and faAnyFile) = sr.Attr then
DeleteFile(sFile); //删除文件
until FindNext(sr) <> 0;
FindClose(sr);
end;
RemoveDir(sPath);
//------------------------------------------------------------------
end;
{
//调用方法
MakeFileList(‘c:\‘, ‘.ini‘);
}
//遍历文件夹中的文件
function MakeFileList(Path,FileExt:string):TStringList ;
var
sch:TSearchrec;
begin
Result:=TStringlist.Create;
if rightStr(trim(Path), 1) <> ‘\‘ then
Path := trim(Path) + ‘\‘
else
Path := trim(Path);
if not DirectoryExists(Path) then
begin
Result.Clear;
exit;
end;
if FindFirst(Path + ‘*‘, faAnyfile, sch) = 0 then
begin
repeat
Application.ProcessMessages;
if ((sch.Name = ‘.‘) or (sch.Name = ‘..‘)) then Continue;
if DirectoryExists(Path+sch.Name) then
begin
Result.AddStrings(MakeFileList(Path+sch.Name,FileExt));
end
else
begin
if (UpperCase(extractfileext(Path+sch.Name)) = UpperCase(FileExt)) or (FileExt=‘.*‘) then
Result.Add(Path+sch.Name);
end;
until FindNext(sch) <> 0;
SysUtils.FindClose(sch);
end;
end;
end.
