使用delphi在线程中删除txt日志

客户的服务器要升级，以往的使用的WIN2008 Server已经不支持售后，因此，需要升级至win2016 Server。而原来一些旧的项目，使用几年后，一直没有清除，发现日志文件非常占用空间，客户要求程序中加入定时清理日志文件功能，如：清除3个月前或半年前的日志。

这个功能很简单，为了不影响程序其他功能的使用，写了一个每天检查清除半年前的日志，代码如下：

1、线程代码

unit uDelLogThread;

interface

uses
Classes, SysUtils;

type
DelLogTh = class(TThread)
public
FilePath: string;
MinFile: string;
protected
procedure Execute; override;
end;

implementation

//判断是否txt日志文件 如：2020-09-03.TXT
function IsTxt(fileName: string): Boolean;
begin
if Length(fileName) <> 14 then
begin
Result := False;
Exit;
end;
if (fileName[5] <> ‘-’) or (fileName[8] <> ‘-’) or (Pos(‘.TXT’,UpperCase(fileName)) = 0) then
begin
Result := False;
Exit;
end;
Result := True;
end;

//删除txt日志
procedure EmptyDirFile(TheDirectory, DelFile:String);
var
SearchRec: TSearchRec;
Res: Integer;
begin
Res := FindFirst(TheDirectory + ‘*.*’, faAnyFile, SearchRec);
try
while Res = 0 do
begin
if (SearchRec.Name <> ‘.’) and (SearchRec.Name <> ‘..’) then
begin
if (SearchRec.Attr and faDirectory) > 0 then
begin
EmptyDirFile(TheDirectory + SearchRec.Name+’\', DelFile);
end else
begin
if IsTxt(SearchRec.Name) then
begin
if SearchRec.Name < DelFile then
begin
DeleteFile(PChar(TheDirectory + SearchRec.Name));
end;
end;
end;
end;
Res := FindNext(SearchRec);
end;
finally
SysUtils.FindClose(SearchRec);
end;
end;

procedure DelLogTh.Execute;
begin
FreeOnTerminate := true;
EmptyDirFile(FilePath,MinFile);
end;

end.

2、调用过程

procedure DelTxtFile;
var
deltxt: DelLogTh;
begin
deltxt := DelLogTh.Create(true);
//指定目录
deltxt.FilePath := ExePath+’DataLog\’;
//获取最小的TXT文件
deltxt.MinFile := FormatDateTime(‘YYYY-MM-DD’,now-180)+’.TXT’;
deltxt.Resume;
end;

然后，那里需要使用直接调用DelTxtFile过程即可，可以放到时钟里面，设置一个时间每天定时清理半年前的TXT日志。