文件夹清理

 

代码

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI, ExtCtrls;

type
  TForm1 = class(TForm)
    grp2: TGroupBox;
    lstFoladerList: TListBox;
    btnAdd: TButton;
    btnEdit: TButton;
    btnDel: TButton;
    btnStart: TButton;
    grp1: TGroupBox;
    edtHourMin: TEdit;
    mmoLog: TMemo;
    tmr1: TTimer;
    lbl1: TLabel;
    procedure btnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnEditClick(Sender: TObject);
    procedure btnDelClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  state:Boolean=False;

implementation

{$R *.dfm}

uses
  IniFiles, FileCtrl;

function DeleteDirectory(const Source:String): boolean;
var
 fo: TSHFILEOPSTRUCT;
begin
 FillChar(fo, SizeOf(fo), 0);
 with fo do
 begin
   Wnd := 0;
   wFunc := FO_DELETE;
   pFrom := PChar(source+#0);
   pTo := PChar(source+#0);
   fFlags := FOF_NOCONFIRMATION+FOF_NOCONFIRMMKDIR    ;
 end;
 Result := (SHFileOperation(fo) = 0);
end;

function EmptyDirectory(TheDirectory:String;Recursive:Boolean):Boolean;
var
  SearchRec : TSearchRec;
  Res : Integer;
begin
  if not ('\' = Copy(TheDirectory, Length(TheDirectory) - 1, 1)) then begin
    TheDirectory := TheDirectory + '\';
  end;
  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) and Recursive then
        begin
          DeleteDirectory(TheDirectory + SearchRec.Name);
        end
        else
        begin
          DeleteFile(PChar(TheDirectory + SearchRec.Name))
        end;
      end;
      Res := FindNext(SearchRec);
   end;
   Result := True;
  finally
    FindClose(SearchRec);
  end;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  if btnStart.Caption = 'Start' then begin
    tmr1.Interval := 40000;
    tmr1.Enabled := True;
    btnStart.Caption := 'Stop';
    edtHourMin.Enabled := False;
    mmoLog.Lines.Add(DateTimeToStr(now) + '   服务已启动')
  end else begin
    btnStart.Caption := 'Start';
    tmr1.Enabled := False;
    edtHourMin.Enabled := True;
    mmoLog.Lines.Add(DateTimeToStr(now) + '   服务已关闭')
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ini:TIniFile;
begin
  //清空文件夹列表
  lstFoladerList.Clear;
  //如列表文件存在,则加载
  if FileExists(extractfilepath(paramstr(0)) + 'FileList.txt') then
  begin
    lstFoladerList.Items.LoadFromFile(extractfilepath(paramstr(0)) + 'FileList.txt');
  end;
  //从ini文件中读hour min
  ini := TIniFile.Create(extractfilepath(paramstr(0)) + 'TimeSet.ini');
  edtHourMin.Text := ini.ReadString('TimeSet', 'HourMin', '00:00');
  ini.Free;
end;

procedure TForm1.btnAddClick(Sender: TObject);
var
  Dir:string;
begin
  if SelectDirectory(Dir,[],12) then begin
    lstFoladerList.Items.Add(Dir + '\');
  end;
end;

procedure TForm1.btnEditClick(Sender: TObject);
var
  Dir:string;
  n:Integer;
begin
  if lstFoladerList.SelCount = 1 then begin
    if SelectDirectory(Dir,[],12) then begin
      //取选择项的INDEX
      n := lstFoladerList.ItemIndex;
      //变更目录
      lstFoladerList.Items.Strings[lstFoladerList.ItemIndex] := Dir + '\';
      //继续保持选择状态
      lstFoladerList.Selected[n] := True;
    end;
  end else begin
    ShowMessage('必须选择一行且只能选择一行,才能进行修改.');
    Exit;
  end;
end;

procedure TForm1.btnDelClick(Sender: TObject);
begin
  if lstFoladerList.SelCount > 0 then begin
    lstFoladerList.DeleteSelected;
  end else begin
    ShowMessage('请先选择要删除的行再进行删除, 可按住CTRL或SHIFT进行多选.');
    Exit;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  ini:TIniFile;
begin
  lstFoladerList.Items.SaveToFile(extractfilepath(paramstr(0)) + 'FileList.txt');
  mmoLog.Lines.SaveToFile(extractfilepath(paramstr(0)) + 'Log.txt');
  ini := TIniFile.Create(extractfilepath(paramstr(0)) + 'TimeSet.ini');
  ini.WriteString('TimeSet', 'HourMin', edtHourMin.Text);
  ini.Free;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
var
  TimeStr:string;
  i:Integer;
begin
  TimeStr := Copy(TimeToStr(Now), 1, 5);
  //如果列表为空则停止
  if lstFoladerList.Count =0 then begin
    Exit;
  end;
  //如果时间到则开始操作
  if TimeStr = edtHourMin.Text then begin
    mmoLog.Lines.Add(DateTimeToStr(Now) + '  时间到,启动清理');
    for i := 0 to lstFoladerList.Count - 1 do begin
      try
        if not DirectoryExists(lstFoladerList.Items.Strings[i]) then begin
          mmoLog.Lines.Add(DateTimeToStr(Now) + '  文件夹 ' + lstFoladerList.Items.Strings[i] + ' 不存在,跳过.');
          Continue;
        end else begin
          EmptyDirectory(lstFoladerList.Items.Strings[i], True);
          mmoLog.Lines.Add(DateTimeToStr(Now) + '  清理 ' + lstFoladerList.Items.Strings[i] + ' 文件夹.');
        end;
      except
        mmoLog.Lines.Add(DateTimeToStr(Now) + '  清理发生异常.');
      end;
    end;
    mmoLog.Lines.Add(DateTimeToStr(Now) + '  清理完毕');
   end;
end;

end.

 

 

窗体代码

object Form1: TForm1
  Left = 192
  Top = 114
  BorderIcons = [biSystemMenu]
  BorderStyle = bsSingle
  Caption = 'Folder Clear Tool   --By eboy'
  ClientHeight = 357
  ClientWidth = 667
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object grp2: TGroupBox
    Left = 8
    Top = 8
    Width = 649
    Height = 281
    Caption = 'Folder List'
    TabOrder = 0
    object lstFoladerList: TListBox
      Left = 16
      Top = 24
      Width = 617
      Height = 217
      ItemHeight = 13
      MultiSelect = True
      TabOrder = 0
    end
    object btnAdd: TButton
      Left = 400
      Top = 248
      Width = 75
      Height = 25
      Caption = 'Add'
      TabOrder = 1
      OnClick = btnAddClick
    end
    object btnEdit: TButton
      Left = 480
      Top = 248
      Width = 75
      Height = 25
      Caption = 'Edit'
      TabOrder = 2
      OnClick = btnEditClick
    end
    object btnDel: TButton
      Left = 560
      Top = 248
      Width = 75
      Height = 25
      Caption = 'Del'
      TabOrder = 3
      OnClick = btnDelClick
    end
  end
  object btnStart: TButton
    Left = 576
    Top = 304
    Width = 75
    Height = 41
    Caption = 'Start'
    TabOrder = 1
    OnClick = btnStartClick
  end
  object grp1: TGroupBox
    Left = 376
    Top = 296
    Width = 185
    Height = 49
    Caption = 'Time Set'
    TabOrder = 2
    object lbl1: TLabel
      Left = 24
      Top = 24
      Width = 49
      Height = 13
      AutoSize = False
      Caption = 'Hour:Min'
    end
    object edtHourMin: TEdit
      Left = 80
      Top = 20
      Width = 81
      Height = 21
      TabOrder = 0
      Text = '05'
    end
  end
  object mmoLog: TMemo
    Left = 8
    Top = 296
    Width = 361
    Height = 49
    ScrollBars = ssVertical
    TabOrder = 3
  end
  object tmr1: TTimer
    Enabled = False
    Interval = 5000
    OnTimer = tmr1Timer
    Left = 320
    Top = 128
  end
end