FileArchiver，为pChao同学定制的文件归档小工具

有一天pChao同学说：

发信人: pChao (树不能长到天上去), 信区: WindowsTech
标题: 谁能帮忙告我这个功能怎么实现
发信站: 水木社区 (Fri Apr 27 21:52:43 2007), 站内

我需要定期清除指定目录内五天以前的文档
请问批处理文件能否做到？或者有其他程序可以做到？
请赐教，谢谢先！

我说：

寄信人: jimeinstein (大鱼若智|再见，小天鹅)
标题: Re: 谁能帮忙告我这个功能怎么实现(转寄)
发信站: 水木社区 (Sat May 12 20:39:11 2007)

才看到……

可以，用VBScript就可以做到。具体的实现，明天晚上我找个时间来做。就是不知道你求到答案没有……

于是，就有了这个东西：FileArchiver。

它的用途就是将当前目录下的过期文件移动到备份目录里，那样的话你想删想存就随便咯，呵呵。

源代码如下：

'过期文件清理器，为pChao同学定制的，hoho
'by bfishadow
'clie.com.cn/blog
Dim WshShell, objShell, objFSO, objFolder, strCurrentDirectory, intMaxDays, strFileExtension, strDateStamp, strUserDate, strBackupFolder, objItem
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strCurrentDirectory = WshShell.CurrentDirectory
Set objFolder = objShell.Namespace(strCurrentDirectory)

'在这里设置运行参数
'intMaxDays          过期文件保存时间，默认为“3”
'strFileExtension    被清理文件的扩展名，默认为“.txt”文件，请务必带上一个点。
'以下为参数设定

intMaxDays = 3
strFileExtension = ".txt"

'以上为参数设定

strDateStamp = CStr(Year(Now))
If Month(Now) <10 Then strDateStamp = strDateStamp & "0"
strDateStamp = strDateStamp & CStr(Month(Now))
If Day(Now) <10 Then strDateStamp = strDateStamp & "0"
strDateStamp = strDateStamp & CStr(Day(Now))

strUserDate = InputBox("请提供一个时间点，在此时间之前生成的文件将被移动到备份目录中。", "过期文件清理器", CStr(Year(Now)) & "-" & CStr(Month(Now)) & "-" & CStr((Day(Now) - intMaxDays)))
strUserDate = CDate(strUserDate)

strBackupFolder = strCurrentDirectory & "\backup" & strDateStamp
If Not objFSO.FolderExists(strBackupFolder) Then objFSO.CreateFolder(strBackupFolder)

For Each objItem in objFolder.Items
  If InStr(LCase(objItem.name), LCase(strFileExtension)) <> 0 Then
    Set objFile = objFSO.GetFile(strCurrentDirectory & "\" & objItem.name)
    strDateCreated = CDate(objFile.DateLastModified)
    If CInt(strUserDate - strDateCreated) > intMaxDays Then
      objFile.Move (strBackupFolder & "\" & objItem.name)
    End If
    Set objFile = Nothing
  End If
Next

Set WshShell = Nothing
Set objShell = Nothing
Set objFSO = Nothing
Set objFolder = Nothing

WScript.Echo "任务完成。"
WScript.Quit

本文链接地址：http://www.clie.com.cn/blog/post/2007/05/gadgets-FileArchiver-an-easy-file-archive-tool.html

大鱼若智，大智若鱼

如鱼得水，如影随形

导航

2007-5-22 13:18:34

FileArchiver，为pChao同学定制的文件归档小工具

Tags: windows script programming

发布:大鱼 | 分类:les gadgets | 评论:0 | 引用:0 | 浏览:

Calendar

TwitterBoy

站内搜索

网站收藏

友情链接

图标汇集

最新评论及回复

最近发表

Proudly Powered By Z-Blog

Copyright © bfishadow inc. (since 2005), some rights reserved.
Except where otherwise noted, this site is licensed under creative commons licence.

大鱼若智，大智若鱼

如鱼得水，如影随形

导航

2007-5-22 13:18:34

FileArchiver，为pChao同学定制的文件归档小工具

Tags: windows script programming

发布:大鱼 | 分类:les gadgets | 评论:0 | 引用:0 | 浏览: strBatchCount+="spn790=790,"

Calendar

TwitterBoy

站内搜索

网站收藏

友情链接

图标汇集

最新评论及回复

最近发表

Proudly Powered By Z-Blog

Copyright © bfishadow inc. (since 2005), some rights reserved.Except where otherwise noted, this site is licensed under creative commons licence.

发布:大鱼 | 分类:les gadgets | 评论:0 | 引用:0 | 浏览:

Copyright © bfishadow inc. (since 2005), some rights reserved.
Except where otherwise noted, this site is licensed under creative commons licence.