2010年2月23日 星期二

程式設計(Delphi) - 移除超過日期的舊檔案

因為之前家裏車停放在門口時, 曾經被小偷敲破玻璃偷走音響/行車電腦. 在家門口裝了台攝影機, 接到電腦上錄影. 因為每天這樣錄下的容量還挺大的, 系統本身又沒有定期刪除舊資料的功能, 所以只好自己寫一個, 免得因為 硬碟空間不足, 而停止錄影.

這個程式適合中放在 Windows 排程中, 可設定每週執行一次, 只保留最近3天的檔案, 這樣就可避免硬碟容量被佔用問題. (會有人需要編好的執行檔嗎? 有需要的留個言吧!)




program rmFolder;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows,
  DateUtils,
  shellapi,
  classes;

procedure ShowSyntax() ;
begin
  writeln('移除超過指定天數前建立的目錄及子目錄') ;
  writeln('Syntax:') ;
  writeln(extractFilename(paramstr(0)),' [/D:天數] 路徑') ;
end ;

(*========================================
  取得超過指定期限的目錄(只找第一層), 存放在 slFolder 傳回.

  傳回值:
    符合條件的個數
*)
function GetFolderPath(sPath:string;iOld:integer;slFolder:TStringList):integer ;
var
  h : THandle ;
  dtSpecDate : TDateTime ;
  wfd : TWIN32FindData ;
  LocalFileTime : TFiletime ;
  systime : TSystemTime ;
  dt : TDateTime ;
begin
  result:=0 ;
  slFolder.Clear ;

  dtSpecDate:=today-iOld ;
  h:=findFirstFile(pchar(sPath+'*'),wfd) ;
  if h=INVALID_HANDLE_value then
    exit ;

  repeat
    if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)<>0) and
      (wfd.cFileName[0]<>'.') then
      begin
      FileTimeToLocalFileTime(wfd.ftCreationTime, LocalFileTime);
      if not FileTimeTosystemtime(localfiletime,systime) then
        exit ;
      dt:=systemtimetodatetime(systime) ;
      if dt<dtSpecDate then
        slFolder.Add(sPath+strpas(wfd.cFileName)) ;
      end ;
    until not FindNextFile(h,wfd) ;

  findClose(h) ;
  result:=slFolder.Count ;
end ;

Function DelTree(DirName : string): Boolean;
var
 SHFileOpStruct : TSHFileOpStruct;
 DirBuf : array [0..MAX_PATH] of char;
begin
 try
   Fillchar(SHFileOpStruct,Sizeof(SHFileOpStruct),0);
   FillChar(DirBuf, Sizeof(DirBuf), 0 );
   StrPCopy(DirBuf, DirName);
   with SHFileOpStruct do
     begin
     Wnd    := 0;
     pFrom  := @DirBuf;
     wFunc  := FO_DELETE;
     fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
     end;
  Result := (SHFileOperation(SHFileOpStruct) = 0);
  except
    Result := False;
 end;
end;

var
  i, iCode : integer ;
  sPath : string ;
  slFolder : TStringList ;
  iDayOld : integer ;
begin

  if paramcount=0 then
    begin
    ShowSyntax() ;
    exit ;
    end ;

  sPath:='' ;
  iDayOld:=0 ;
  for i:=1 to paramcount do
    begin
    if copy(ParamStr(i),1,3)='/D:' then
      begin
      val(Copy(ParamStr(i),4,6),iDayOld,iCode) ;
      if iCode<>0 then
        begin
        Showsyntax() ;
        exit ;
        end ;
      end ;

    if DirectoryExists(ParamStr(i)) then
      begin
      sPath:=ParamStr(i) ;
      end ;
    end ;

  if AnsiLastChar(sPath)^<>'\' then
    sPath:=sPath+'\' ;

  slFolder:=TStringList.Create ;
  iCode:=GetFolderPath(sPath,iDayOld,slFolder) ;
  for i:=0 to iCode-1 do
    begin
    DelTree(slFolder[i]) ;
    end ;
end.

張貼者： Aquarius 於 晚上11:37
標籤：

沒有留言:

張貼留言

訂閱： 張貼留言 (Atom)