2012年2月7日 星期二

archive system log by schedule tasks


' 由於某些軟體會產生大量的檔案,特建立備存機制,
' 1. 將特定目錄下的子目錄都備存起來,並刪除空的子目錄
' 2. 需先安裝WINRAR
' 3. 將下列程式做成.vbs 檔案
' 4. 建立Task schedule , 將備存的目錄設為參數
'
'--- .vbs 程式開始
Option Explicit
 
' 宣告變數
Dim FSO, agoDays, modifiedDate, ArcFolder  ,myArgs, GetDateTimeFM, wshshell

' 建立檔案系統物件(File System Object)
Set FSO = CreateObject("Scripting.FileSystemObject")
' 建立執行的shell 物件
Set wshshell=createobject ("wscript.shell")
'取得第一個變數
Set myArgs = WScript.arguments
' 欲備存檔案所在之目錄    
ArcFolder = myArgs(0)
' 取得日期(yyyy_mm_dd_hh_nn_ss)
GetDateTimeFM = GetFormattedDateTime()

' 呼叫備存檔案的子程序
ArcFilesInFolder FSO.GetFolder(ArcFolder)    

' 呼叫刪除空Folder的子程序
DelFoldersInFolder FSO.GetFolder(ArcFolder)    

' 備存目錄的子程序
Sub ArcFilesInFolder(folder)
  ' 宣告變數
  Dim file, subFolder,strshell
  ' 如果遇到子目錄,也要進去檢查並刪除
  For Each subFolder in folder.SubFolders
      strshell = "WinRAR.exe a -r -df " + SubFolder + "-dt-" + GetDateTimeFM + ".rar " + subFolder + "\"
      Call wshshell.run (strshell,0)
Next
End Sub  

' 刪除檔案的子程序
Sub DelFoldersInFolder(folder)
  ' 宣告變數
  Dim dfile, dsubFolder, fdEmpty  
  ' 如果遇到子目錄,要先進去檢查並刪除
  For Each dsubFolder in folder.SubFolders
      DelFoldersInFolder dsubFolder
Next  
  fdEmpty = True
  ' 找出目前所在目錄內所有的檔案
  For Each dfile In folder.Files ' 檢查檔案日期是否符合條件,若符合,就刪除
      fdEmpty = False
  Next    
  For Each dsubFolder in folder.SubFolders
  fdEmpty = False
    Next
    If fdEmpty = True Then
    folder.delete
  End If
End Sub  

' 取得日期的函式
Function GetFormattedDateTime
  Dim strNow, strDD, strMM, strYYYY,strHH,strNN,strSS
strYYYY = DatePart("yyyy",Now())
strMM = Right("0" & DatePart("m",Now()),2) 'month
strDD = Right("0" & DatePart("d",Now()),2) 'day
strHH = Right("0" & DatePart("h",Now()),2) 'hour
strNN = Right("0" & DatePart("n",Now()),2)  'mintue
strSS = Right("0" & DatePart("s",Now()),2) 'second
GetFormattedDateTime = strYYYY & "_" & strMM & "_" & strDD & "_" & strHH & "_" & strNN & "_" & strSS
End Function
'--- .vbs 程式結束

沒有留言:

張貼留言