2011/01/26

[tool][VBScript] 用來刪除空資料夾的小工具

因為有些程式或 3rd-party 工具會產生一些暫時用的資料夾, 為了管理方便, 會想定時清掉沒資料或是過期的的資料夾. 這個小工具就是為了做這種事而寫的.
以下的程式可以包裝成 .vbs 檔, 然後設定到每日排程去執行.
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Dim oFS  
Dim oFSFolder  
Dim sPath, sFlagPath, nExpireDays
 
Dim dFlagDate
' 根目錄
sPath = "D:\test"
' 用來比對資料是否過期的 flag 檔案
sFlagPath = sPath & "\flag"
' 預設3天前的資料夾算是過期的資料夾
nExpireDays = -3
 
Set oFS = CreateObject("Scripting.FileSystemObject")
 
' 判斷根目錄是否存在
If Not oFS.FolderExists(sPath) Then
  Set oFS = Nothing
  WScript.Quit 0
End If
 
' 讀取後續要做日期判斷的設定值
dFlagDate = ReadDateFlag(sFlagPath)
 
Set oFSFolder = oFS.GetFolder(sPath)
' 取得根目錄下所有的子目錄
Set fDates = oFSFolder.SubFolders
For Each fDateItem in fDates
  If fDateItem.DateLastModified <= dFlagDate Then
    ' 利用遞迴的方式刪除不要(空)的資料夾
    DeleteEmptyFolder(fDateItem)
  End If
Next
Set oFSFolder = Nothing
Set oFS = Nothing
 
Sub DeleteEmptyFolder(oFolder)
  Set oFSFolder = oFS.GetFolder(oFolder.Path)
  Set fItems = oFSFolder.SubFolders
  ' 這邊是判斷檔案和資料夾都為空的情況, 如果是要刪過期的資料, 可再另外判斷
  If (oFSFolder.SubFolders.Count + oFSFolder.Files.Count)=0 Then
    ' 如果此資料夾底下無資料, 刪除此資料夾
    oFS.DeleteFolder oFSFolder.Path
  Else
    ' 如果有檔案或是資料夾, 繼續往下進行刪除的動作
    For Each fItem in fItems
      DeleteEmptyFolder(fItem)
    Next
  End If
End Sub
 
Function ReadDateFlag(sFlagPath)
  Dim fFlag, dFlagDate, strDate
  strDate = ""
  If Not oFS.FileExists(sFlagPath) Then
    ' 如果 flag 檔不存在, 將預設的日期資料寫入 flag 檔
    dFlagDate = DateAdd("d", nExpireDays, Date)
    ' 日期格式為: yyyy-MM-dd
    strDate = Year(dFlagDate) & "-" & Month(dFlagDate) & "-" & Day(dFlagDate)
    Set fFlag = oFS.OpenTextFile(sFlagPath, 8, True)
    fFlag.Write strDate
    fFlag.Close
    ReadDateFlag = CDate(strDate)
  Else
    ' 如果 flag 檔已存在, 讀取上次執行的日期戳記
    Set fFlag = oFS.OpenTextFile(sFlagPath, 1)
    If strDate="" Then
      If Not fFlag.AtEndOfStream Then
        strDate = fFlag.ReadLine
        dFlagDate = DateAdd("d", 1, CDate(strDate))
        strDate = Year(dFlagDate) & "-" & Month(dFlagDate) & "-" & Day(dFlagDate)
      End If
    End If
    fFlag.Close
    ' 用覆寫的方式寫回 flag 檔
    Set fFlag = oFS.OpenTextFile(sFlagPath, 2, True)
    fFlag.Write strDate
    fFlag.Close
    ReadDateFlag = CDate(strDate)
  End If 
End Function
相關參考資料:
張貼者： 於
標籤：

沒有留言:

張貼留言

訂閱： 張貼留言 (Atom)