仕事で使っているアプリケーションがExeName_YYYYMMDDHHNNSS.Logのような
ログファイルを一杯作るので、消してくれという依頼があった。
ただし、このフォルダには、上記のログを作るファイルがいくつかああって
3世代程度は残してくれという依頼があった。
昔、仕事で触ってたOpenVmsのファイルシステムにはバージョンというのが
あって、古いバージョンのファイルを消すPurgeコマンドがあり
これとにたようなものが欲しいなということで、とりあえず作ってみた。
(本家には似ても似つかぬ、あくまでももどきですが。）
使い方は、
PurgeMock "パージファイルマスク" /D:パージファイルがあるフォルダ /G:残す世代数
で、/R: を指定することで、パージファイルマスクに正規表現が使用できます。
また、ファイルの更新日時を基準に/G:で指定した数だけ残るよう古い日付のものを
削除しますが、 /T:を指定することでファイルの作成日時を基準にPurgeすることが
できます。
なお、パージファイルマスクにより、複数の異なるファイル名のファイルが削除対象
となりえますが、このツールでは、このような場合のことを想定しておりません。
（/G:で指定した数になるようにばっさり消します。）
以下、ソース(delphi Xeがあればコンパイル可能です。)を置いておきます。
ライセンスは、MITライセンスとします。
ソース使用は自由ですが、無保証とします。
まずはメイン。
program PurgeMock;
{$APPTYPE CONSOLE}
uses
SysUtils,
PurgeMockImp in 'PurgeMockImp.pas',
MidasLib
;
function CreatePurgeMockParams : TPurgeMockParams;
var
PurgeMockParams : TPurgeMockParams;
i : Integer;
begin
PurgeMockParams := TPurgeMockParams.Create;
try
try
PurgeMockParams.Init(Paramstr(0));
for i := 1 to ParamCount -1 do
begin
PurgeMockParams.SetPurgeParam(Paramstr(i));
end;
except
PurgeMockParams.Free;
PurgeMockParams := nil;
end;
finally
Result := PurgeMockParams;
end;
end;
var
PurgeMockParams : TPurgeMockParams;
DoPurgeMock : TPuregMock;
Ret : Integer;
begin
try
{ TODO -oUser -cConsole メイン : ここにコードを記述してください }
PurgeMockParams := CreatePurgeMockParams;
if Assigned(PurgeMockParams) then
begin
DoPurgeMock := TPuregMock.Create(PurgeMockParams);
try
Ret := DoPurgeMock.Purge;
finally
DoPurgeMock.Free;
end;
PurgeMockParams.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
次に、パージコマンドの本体
unit PurgeMockImp;
interface
uses
SysUtils
,DB
,DBClient
;
type
TPurgeTimeStamp = (ptCreate, ptUpdate);
TPurgeMockParams = class
private
FTargetDir: String;
FUseRegularExpression: Boolean;
FFileMask: String;
FLeavingGenerations: Integer;
FPurgeTimeStamp: TPurgeTimeStamp;
procedure SetTargetDir(val: String);
procedure SetUseRegularExpression(val: Boolean);
procedure SetFileMask(val: String);
procedure SetLeavingGenerations(val: Integer);
procedure SetPurgeTimeStamp(val: TPurgeTimeStamp);
public
property TargetDir: String read FTargetDir write SetTargetDir;
property UseRegularExpression: Boolean read FUseRegularExpression
write SetUseRegularExpression;
property FileMask: String read FFileMask write SetFileMask;
property LeavingGenerations: Integer read FLeavingGenerations
write SetLeavingGenerations;
property PurgeTimeStamp: TPurgeTimeStamp read FPurgeTimeStamp
write SetPurgeTimeStamp;
procedure Init(ExePath: String);
procedure SetPurgeParam(PurgeParam : String);
end;
TPuregMock = class
public
constructor Create(Params: TPurgeMockParams);
function Purge: Integer;
destructor Destroy; override;
strict private
FPurgeMockParams: TPurgeMockParams;
FPurgeMockDataSet : TClientDataSet;
function MakePurgeFileList: Integer;
function ExecPurge: Integer;
function CreatePurgeDataSet : TClientDataSet;
end;
function TryParseCmdLineSw(ParameterString : String; Sw : Array of String; var ParamValue : String; IgnoreCase: Boolean = true) : boolean;
implementation
Uses
StrUtils
,IOUtils
,Types
,RegularExpressionsCore
;
procedure TPurgeMockParams.SetTargetDir(val: String);
begin
FTargetDir := val;
end;
procedure TPurgeMockParams.SetUseRegularExpression(val: Boolean);
begin
FUseRegularExpression := val;
end;
procedure TPurgeMockParams.Init(ExePath: String);
begin
FTargetDir := ExtractFileDir(ExePath);
FUseRegularExpression := false;
FileMask := '*.*';
FLeavingGenerations := 1;
FPurgeTimeStamp := ptUpdate;
end;
procedure TPurgeMockParams.SetFileMask(val: String);
begin
FFileMask := val
end;
procedure TPurgeMockParams.SetLeavingGenerations(val: Integer);
begin
if Val >= 0 then
begin
FLeavingGenerations := val;
end
else
begin
FLeavingGenerations := 0;
end;
end;
procedure TPurgeMockParams.SetPurgeParam(PurgeParam: String);
var
ValueStr : String;
begin
if TryParseCmdLineSw(PurgeParam,['/D:','-D:'],ValueStr) then
begin
FTargetDir := ValueStr;
Exit;
end;
if TryParseCmdLineSw(PurgeParam,['/U:','-U:'],ValueStr) then
begin
FUseRegularExpression := true;
Exit;
end;
if TryParseCmdLineSw(PurgeParam,['/G:','-G:'],ValueStr) then
begin
LeavingGenerations := StrToIntDef(ValueStr,1);
Exit;
end;
if TryParseCmdLineSw(PurgeParam,['/T:','-T:'],ValueStr) then
begin
FPurgeTimeStamp := ptCreate;
Exit;
end;
if TryParseCmdLineSw(PurgeParam,[],ValueStr) then
begin
FFileMask := ValueStr;
Exit;
end;
end;
procedure TPurgeMockParams.SetPurgeTimeStamp(val: TPurgeTimeStamp);
begin
FPurgeTimeStamp := val;
end;
constructor TPuregMock.Create(Params: TPurgeMockParams);
begin
inherited Create;
FPurgeMockParams := Params;
end;
function TPuregMock.Purge: Integer;
begin
Result := -1;
FPurgeMockDataSet := CreatePurgeDataSet;
if Assigned(FPurgeMockDataSet) then
begin
if MakePurgeFileList > 0 then
begin
Result := ExecPurge;
end;
FPurgeMockDataSet.EmptyDataSet;
FPurgeMockDataSet.Active := false;
FPurgeMockDataSet.Free;
end;
end;
function TPuregMock.CreatePurgeDataSet: TClientDataSet;
var
PurgeDataSet : TClientDataSet;
FD : TFieldDef;
begin
PurgeDataSet := TClientDataSet.Create(nil);
try
try
FD := PurgeDataSet.FieldDefs.AddFieldDef;
FD.Name := 'FileName';
FD.DataType := ftString;
FD.Size := 1024;
FD := PurgeDataSet.FieldDefs.AddFieldDef;
FD.Name := 'TimeStamp';
FD.DataType := ftDatetime;
PurgeDataSet.CreateDataSet;
PurgeDataSet.AddIndex('Purge_Idx','TimeStamp;FileName',[]);
PurgeDataSet.IndexName := 'Purge_Idx';
Except
if Assigned(PurgeDataSet) then PurgeDataSet.Free;
PurgeDataSet := nil;
end;
finally
Result := PurgeDataSet;
end;
end;
destructor TPuregMock.Destroy;
begin
if Assigned(FPurgeMockParams) then
begin
FPurgeMockParams := nil;
end;
inherited Destroy;
end;
function TPuregMock.MakePurgeFileList: Integer;
var
SearchOption: TSearchOption;
SearchDir : TDirectory;
SearchFileMask : String;
LList: TStringDynArray;
FileFullName,FileName : String;
CanAddList : Boolean;
PerlRegEx: TPerlRegEx;
PurgeFile : TFile;
begin
Result := 0;
//使っても使わなくても正規表現用のクラスをオープンしておく。
PerlRegEx:= TPerlRegEx.Create;
try
SearchOption := TSearchOption.soTopDirectoryOnly;
SearchFileMask := FPurgeMockParams.FileMask;
if FPurgeMockParams.UseRegularExpression then
begin
PerlRegEx.RegEx := SearchFileMask;
SearchFileMask := '*.*';
end;
try
LList := SearchDir.GetFiles(FPurgeMockParams.FTargetDir,SearchFileMask, SearchOption);
FPurgeMockDataSet.Active := true;
for FileFullName in LList do
begin
CanAddList := true;
if FPurgeMockParams.UseRegularExpression then
begin
FileName := ExtractFileName(FileFullName);
PerlRegEx.Subject := FileName;
CanAddList := PerlRegEx.Match;
end;
if CanAddList then
begin
//パージ対象リストに追加
FPurgeMockDataSet.Append;
FPurgeMockDataSet.FieldByName('FileName').AsString := FileFullName;
if FPurgeMockParams.FPurgeTimeStamp = ptCreate then
begin
FPurgeMockDataSet.FieldByName('TimeStamp').AsDateTime := PurgeFile.GetCreationTime(FileFullName);
end
else
begin
FPurgeMockDataSet.FieldByName('TimeStamp').AsDateTime := PurgeFile.GetLastAccessTime(FileFullName);
end;
FPurgeMockDataSet.Post;
end;
end;
Result := FPurgeMockDataSet.RecordCount;
except
Result := -1;
end;
finally
if Assigned(PerlRegEx) then PerlRegEx.Free;
end;
end;
function TPuregMock.ExecPurge: Integer;
var
DeleteCount : integer;
DeleteFileName : string;
PurgeFile : TFile;
begin
DeleteCount := 0;
try
FPurgeMockDataSet.Active := true;
FPurgeMockDataSet.First;
while not(FPurgeMockDataSet.Eof) do
begin
DeleteFileName := FPurgeMockDataSet.FieldByName('FileName').AsString;
PurgeFile.Delete(DeleteFileName);
inc(DeleteCount);
//レコードをDeleteした場合は、Next不要なので注意
FPurgeMockDataSet.Delete;
if FPurgeMockDataSet.RecordCount <= FPurgeMockParams.LeavingGenerations then Break;
end;
Result := DeleteCount;
Except
Result := -1;
end;
end;
function TryParseCmdLineSw(ParameterString : String;
Sw : Array of String;
var ParamValue : String;
IgnoreCase: Boolean) : boolean;
var
i : integer;
begin
Result := false;
if Length(Sw) = 0 then
begin
//SW指定がない場合はそのままの文字列を返す
ParamValue := ParameterString;
Result := true;
end
else
begin
for i := low(Sw) to high(Sw) do
begin
if IgnoreCase then
begin
if StartsText(Sw[i],ParameterString) then
begin
Result := true;
ParamValue := ReplaceText(ParameterString,Sw[i],'');
Break;
end;
end
else
begin
if StartsStr(Sw[i],ParameterString) then
begin
Result := true;
ParamValue := ReplaceStr(ParameterString,Sw[i],'');
Break;
end;
end;
end;
end;
end;
end.
