unit1.pas

删除指定天数前的文件

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl,inifiles, ComCtrls, ExtCtrls, Menus, TrayIcon;
type
    TRec_fileinfo = record
      Filepath :string;          //存放文件路径
      Filename :string;          //文件名称
      Creationtime : Tdatetime;  //文件建立时间
      status : integer;          //文件的状态  0：已经删除 1：未删除
    end;

type
  TForm1 = class(TForm)
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Button3: TButton;
    Label3: TLabel;
    Button4: TButton;
    Timer1: TTimer;
    DateTimePicker1: TDateTimePicker;
    Label4: TLabel;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    TrayIcon1: TTrayIcon;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    FilterComboBox1: TFilterComboBox;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Timer2: TTimer;
    Bevel1: TBevel;
    Label5: TLabel;
    Button12: TButton;
    RadioGroup1: TRadioGroup;
    RadioButton2: TRadioButton;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    RadioButton1: TRadioButton;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N1Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  s :array [0..1000]  of Trec_fileinfo;
  filecount :integer;
  initdir,filekeepdays,time :string;
  Ini: TIniFile;
  Filename,dir : string;
  password :string;
  filters :string;
  filetype :Tfiletype;
implementation

uses about;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var i,F : integer;
  CreateFT, LastAccessFT, LastWriteFT: TFileTime;
  ST: TSystemTime;
  filepath :string;
begin

  filelistbox1.Update;
  filecount := 0;
  for i := 0 to filelistbox1.Items.Count - 1  do
    begin
        if  AnsiStrLastChar(pchar(directorylistbox1.Directory)) <> '\' then
           filepath := directorylistbox1.Directory + '\'
          else
           filepath := directorylistbox1.Directory;

        f := CreateFile(pchar(filelistbox1.Items.Strings[i]), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

        if F=INVALID_HANDLE_VALUE then
           begin
             ShowMessage('Can not open file!');
             Exit;
           end;
           { 取文件时间 }
          if GetFileTime(F, @CreateFT, @LastAccessFT, @LastWriteFT) then
            begin
            { 转换为系统时间并显 示，同时确定是按文件的创建时间还是按文件的最后修改时间删除}
              if RadioButton1.Checked then
                FileTimeToSystemTime(CreateFT, ST)
               else
                FileTimeToSystemTime(LastWriteFT, ST);
              s[i+1].Filepath := filepath;
              s[i+1].Filename := filelistbox1.Items.Strings[i];
              s[i+1].Creationtime := systemtimetodatetime(st);
              s[i+1].status := 1;
              inc(filecount);
              //Format('%d-%d-%d %0d:%0d:%0d',[ST.wYear, ST.wMonth, ST.wDay,ST.wHour, ST.wMinute,ST.wSecond]);
            end;
          CloseHandle(F);  // 记住关闭文件
    end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
   Filename:=ExtractFilePath(Paramstr (0))+'delphi.ini';
   Ini := TIniFile.Create(Filename);
   initdir := ini.ReadString('system','initdir','c:\');
   filekeepdays := ini.ReadString('system','filekeepdays','1');
   time := ini.ReadString('system','time','01:30:01');
   filters := ini.ReadString('system','filter',' ');
   filtercombobox1.Filter := filters;
   DateTimePicker1.Time := strtodatetime(time);
   drivecombobox1.Drive := initdir[1];
   directorylistbox1.Directory := initdir;
   label3.Caption := '文件保留天数：' + filekeepdays + '天';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ini.WriteString('system','initdir',directorylistbox1.Directory);
  //showmessage('设置成功！！！');
end;

procedure TForm1.Button3Click(Sender: TObject);
var days :string;
begin
  days := inputbox('提示','请输入文件保留天数,有效范围：-30天 至 30天',ini.ReadString('system','filekeepdays','3'));
  if (strtoint(days) < -30) or (strtoint(days) > 30) then
    begin
      showmessage('输入的数据不是数字，请重新输入！！！');
      Button3Click(sender);
    end
   else
    begin
      ini.WriteString('system','filekeepdays',days);
      filekeepdays := days;
      label3.Caption := '文件保留天数：' + days + '天';
      //showmessage('请重新启动程序，以使新设置的文件保留天数后效！！！');
    end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var i :integer;
    year1,month1,day1 :word;
    keeptime :Tdatetime;
    day : longint;
begin
 try
   for i := 1 to filecount do
     begin
       //DecodeDate(s[i].Creationtime,year1,month1,day1);
       //分解当时的日期
       DecodeDate(now,year1,month1,day1);
       //计算当天与设置的文件保留天数的差
       day := longint(day1) - longint(strtoint(filekeepdays));
       if day < 0 then
         begin
           month1 := month1 - 1 ; //此处不考虑超过一个月的情况
           if month1 = 0 then
              begin
               month1 := 12;
               year1 := year1 - 1;
              end;
            case month1 of
              2: day := 28 + day;
              1,3,5,7,8,10,12:day := 31 + day;
              4,6,9,11:day := 30 + day;
            end;
         end;
       if day = 0 then
         begin
           month1 := month1 - 1 ;   //此处不考虑超过一个月的情况
           if month1 = 0 then
              begin
               month1 := 12;
               year1 := year1 - 1;
              end;
            case month1 of
              2: day := 28 ;
              1,3,5,7,8,10,12:day := 31 ;
              4,6,9,11:day := 30 ;
            end;
         end;
       if day > 0 then
         begin
           case month1 of
             2: if day > 28 then
                  begin
                     month1 := month1 + 1 ;
                     day := day - 28;
                  end;
              1,3,5,7,8,10: if day > 31 then
                              begin
                                month1 := month1 + 1;
                                day := day - 31;
                              end;
              4,6,9,11 : if day > 30 then
                           begin
                             month1 := month1 + 1 ;
                             day := day - 30;
                           end;
              12 : if day > 31 then
                    begin
                      year1 := year1 + 1 ;
                      month1 := 1 ;
                      day := day - 31;
                    end;

           end;
         end;

       keeptime := encodedate(year1,month1,day);
       //memo1.Lines.Add(datetimetostr(keeptime));
       //showmessage(datetostr(keeptime));
       //showmessage(datetostr(s[i].Creationtime));
       if s[i].Creationtime < keeptime then
        begin
         windows.DeleteFile(pchar(s[i].Filepath + '\' + s[i].filename));
         label5.Caption := '已于' + datetimetostr(now) +'执行成功！';
        end;
     end;

   except
     label5.Caption := '没有执行成功！时间：' + datetimetostr(now);
   end;

end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  ini.WriteString('system','time',timetostr(DateTimePicker1.Time));
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  filelistbox1.Update ;
  if timetostr(now) = ini.ReadString('system','time','01:30:01') then
    begin
      button1.Click ;
      button4.Click ;
    end;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  if button8.Caption = '开始' then
    begin
       timer1.Enabled := true;
       button8.Caption := '停止';
       button2.Click ;
       button5.Click ;

     end
   else
    begin
     timer1.Enabled := false;
     button8.Caption := '开始';
     
    end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
   password := inputbox('加锁','请输入加锁密码：','');
   if password <> '' then
     begin
       directorylistbox1.Enabled := false;
       datetimepicker1.Enabled := false;
       drivecombobox1.Enabled := false;
       filelistbox1.Enabled := false;
       button1.Enabled := false;
       button2.Enabled := false;
       button3.Enabled := false;
       button4.Enabled := false;
       button5.Enabled := false;
       button8.Enabled := false;
       button6.Enabled := false;
       button9.Enabled := false;
       button11.Enabled := false;
       button12.Enabled := false;
       FilterComboBox1.Enabled := false;
       RadioButton1.Enabled := false;
       RadioButton2.Enabled := false;
       button7.Enabled := true;
       N2.Enabled := false;
       N3.Enabled := true;
     end
    else
       showmessage('密码不能为空！！！');
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  if password = inputbox('解锁','请输入解锁密码：','') then
    begin
       directorylistbox1.Enabled := true;
       datetimepicker1.Enabled := true;
       drivecombobox1.Enabled := true;
       filelistbox1.Enabled := true;
       button1.Enabled := true;
       button2.Enabled := true;
       button3.Enabled := true;
       button4.Enabled := true;
       button5.Enabled := true;
       button6.Enabled := true;
       button8.Enabled := true;
       button7.Enabled := false;
       button9.Enabled := true;
       button11.Enabled := true;
       button12.Enabled := true;
       FilterComboBox1.Enabled := true;
       RadioButton1.Enabled := true;
       RadioButton2.Enabled := true;
       N2.Enabled := true;
       N3.Enabled := false;
    end
   else
     showmessage('密码不正确！！！');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if button7.Enabled then
    if password <> inputbox('解锁','请输入解锁密码：','') then
         begin
           showmessage('密码不正确！！！');
           action := caNone;
         end;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
   trayicon1.Restore ;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  filters := inputbox('设置文件过滤','请按下面例子输入                                                  All files (*.*)|*.*|word(*.doc)|*.doc ',ini.ReadString('system','filter',''));
  ini.WriteString('system','filter',filters);
  filtercombobox1.Filter := filters;
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
      button1.Click ;
      button4.Click ;
      filelistbox1.Update ;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  filelistbox1.Update ;
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
  w_about.ShowModal ;
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
  form1.Close;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
var s :string;
begin
  {if checkbox1.Checked then
    s := 'ftHidden'
    else
    s := '';
  if checkbox2.Checked then
    begin
      if s <> '' then
        s := ',' + 'ftReadOnly'
        else
        s := 'ftReadOnly';
    end;
  if checkbox3.Checked then
    begin
      if s <> '' then
        s := ',' + 'ftSystem'
        else
        s := 'ftSystem';
    end;
  if checkbox4.Checked then
    begin
      if s <> '' then
        s := ',' + 'ftArchive'
        else
        s := 'ftArchive';
    end;
  filetype := '(' + s + ',ftNormal)';
  filelistbox1.FileType := filetype;}
  //filelistbox1.FileType := '[ftHidden,ftSystem,ftArchive,ftNormal]';
  //filelistbox1.Update ;
end;

end.