利用Scripting.FileSystemObject组件来枚举文件

!本文可能 超过1年没有更新，今后内容也许不会被维护或者支持，部分内容可能具有时效性，涉及技术细节或者软件使用方面，本人不保证相应的兼容和可操作性。

基本的算法思想就是首先获得文件夹下的文件集合，然后枚举文件，然后再获得文件夹下子文件夹的集合，然后递归枚举，实际操作时为了更好的模块化，使用了回调函数，如果找到文件就自动交给指定函数处理，我们约定函数的格式如下：

FUNCTION(FileSystemObject, FileObject, Parameter) RETURN AS BOOL

首先第一个参数是FileSystemObject，就是将创建好的Scripting.FileSystemObject对象传入函数让我们加以利用。
其次第二个参数是FileObject，也就是枚举出的单独文件对象，我们可以通过这个对象获得文件一系列的属性和方法。
最后一个参数是Parameter，是在调用枚举时传入的参数，没有特殊需要可以忽略。
返回值，如果返回TRUE则中止枚举，否则将继续枚举直到枚举结束。

VBScript实现如下。

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

Class FileOperation
 
    Private AxFile   
    Private Sub Class_Initialize()
        Set AxFile = WSH.CreateObject("Scripting.FileSystemObject")
    End Sub
 
    Private Sub Class_Terminate()
        Set AxFile = Nothing
    End Sub
 
    Private Function GetSubFolders(strFolder)
        If AxFile.FolderExists(strFolder) Then
            Dim oFolders
            Set oFolders = AxFile.GetFolder(strFolder)
            Set GetSubFolders = oFolders.SubFolders
            Set oFolders = Nothing
        Else
            Set GetSubFolders = Nothing
        End If
    End Function
 
    Private Function GetSubFiles(strFolder)
        If AxFile.FolderExists(strFolder) Then
            Dim oFolders
            Set oFolders = AxFile.GetFolder(strFolder)
            Set GetSubFiles = oFolders.Files
            Set oFolders = Nothing
        Else
            Set GetSubFiles = Null
        End If
    End Function
 
    Public Function EnumFiles(strFolder, fCallBackName, Param)
        EnumFiles = True
        If Not AxFile.FolderExists(strFolder) Then
            EnumFiles = False
            Exit Function
        End If
 
        Dim fCallBack
        Dim SubFiles, SubFile, SubFolders, SubFolder
 
        Set fCallBack = GetRef(fCallBackName)
 
        Set SubFiles = GetSubFiles(strFolder)
        For Each SubFile In SubFiles
            If fCallBack(AxFile, SubFile, Param) Then Exit For
        Next
        Set SubFiles = Nothing
 
        Set SubFolders = GetSubFolders(strFolder)
        For Each SubFolder In SubFolders
            Call EnumFiles(AxFile.GetAbsolutePathName(SubFolder), _
                                  fCallBackName, Param)
        Next
        Set SubFolders = Nothing
 
        Set fCallBack = Nothing
    End Function
 
End Class

貌似VBScript没有函数指针的概念，在查阅了脚本手册后找到GetRef函数，用以根据字符串格式的函数名获取函数的引用，虽然看上去比较别扭，但是还是可以实现函数指针这个功能的。

JavaScript/JScript实现如下。

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

function FileOperation() {
    this.self = WSH.CreateObject("Scripting.FileSystemObject");
 
    this.getSubFolders = function(fdr) {
        if (!this.self.FolderExists(fdr))
            return null;
        return (this.self.GetFolder(fdr).SubFolders);
    }
 
    this.getSubFiles = function(fdr) {
        if (!this.self.FolderExists(fdr))
            return null;
        return (this.self.GetFolder(fdr).Files);
    }
 
    this.enumFiles = function(fdr, callback, param) {
        if (!this.self.FolderExists(fdr))
            return false;
        var SubFiles = new Enumerator(this.getSubFiles(fdr));
        for (; !SubFiles.atEnd(); SubFiles.moveNext())
        {
            if (callback(this.self, SubFiles.item(), param))
                return true;
        }
        var SubFolders = new Enumerator(this.getSubFolders(fdr));
        for (; !SubFolders.atEnd(); SubFolders.moveNext()) {
            this.enumFiles(
            this.self.GetAbsolutePathName(SubFolders.item()),
            callback, param);
        }
        return true;
    }
}

JavaScript/JScript的将函数名作为变量传入很方便的实现了函数指针的功能，在这点上JavaScript/JScript的灵活性还是略胜一筹的，不过其foreach功能就没有VBScript那么好用了。

2012年3月21日更新

对VBScript类做了修改，增加了文件夹枚举搜索，增加递归开关，并且为了保证调用灵活，修改了回调原型函数。

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

' Author : wangye
' http://wangye.org
Class FileOperation
 
    Private AxFile   
    Private Sub Class_Initialize()
        Set AxFile = WSH.CreateObject("Scripting.FileSystemObject")
    End Sub
 
    Private Sub Class_Terminate()
        Set AxFile = Nothing
    End Sub
 
    Private Function GetSubFolders(strFolder)
        If AxFile.FolderExists(strFolder) Then
            Dim oFolders
            Set oFolders = AxFile.GetFolder(strFolder)
            Set GetSubFolders = oFolders.SubFolders
            Set oFolders = Nothing
        Else
            Set GetSubFolders = Nothing
        End If
    End Function
 
    Private Function GetSubFiles(strFolder)
        If AxFile.FolderExists(strFolder) Then
            Dim oFolders
            Set oFolders = AxFile.GetFolder(strFolder)
            Set GetSubFiles = oFolders.Files
            Set oFolders = Nothing
        Else
            Set GetSubFiles = Null
        End If
    End Function
 
    ' EnumFiles 枚举指定文件夹文件
    '
    ' 回调函数原型为 CallBack(self, fso, file, param)
    '     self  Class FileOperation实例化对象
    '     fso   Scripting.FileSystemObject对象
    '     file  枚举到的文件对象
    '     param 传递给回调函数的参数（如果需要）
    '
    ' strFolder     要枚举的文件所在的文件夹
    ' fCallBackName 列出的每个文件所调用的回调函数名称
    ' Recursion     是否递归搜索
    ' Param         传递给回调函数的参数（如果需要）
    Public Function EnumFiles(strFolder, fCallBackName, Recursion, Param)
        EnumFiles = True
        If Not AxFile.FolderExists(strFolder) Then
            EnumFiles = False
            Exit Function
        End If
 
        Dim fCallBack
        Dim SubFiles, SubFile, SubFolders, SubFolder
 
        Set fCallBack = GetRef(fCallBackName)
 
        If TypeName(strFolder) = "Folder" Then
            Set SubFiles = strFolder.Files
        Else
            Set SubFiles = GetSubFiles(strFolder)
        End If
        For Each SubFile In SubFiles
            If fCallBack(Me, AxFile, SubFile, Param) Then Exit For
        Next
        Set SubFiles = Nothing
 
        If Recursion Then
        Set SubFolders = GetSubFolders(strFolder)
            For Each SubFolder In SubFolders
                Call EnumFiles(AxFile.GetAbsolutePathName(SubFolder), _
                          fCallBackName, Recursion, Param)
            Next
            Set SubFolders = Nothing
        End If
 
        Set fCallBack = Nothing
    End Function
 
    ' EnumFolders 枚举指定文件夹
    '
    ' 回调函数原型为 CallBack(self, fso, folder, param)
    '     self  Class FileOperation实例化对象
    '     fso   Scripting.FileSystemObject对象
    '     folder  枚举到的文件夹对象
    '     param 传递给回调函数的参数（如果需要）
    '
    ' strFolder     要枚举的文件夹所在的文件夹
    ' fCallBackName 列出的每个文件夹所调用的回调函数名称
    ' Recursion     是否递归搜索
    ' Param         传递给回调函数的参数（如果需要）
    Public Function EnumFolders(strFolder, fCallBackName, Recursion, Param)
        EnumFolders = True
        If Not AxFile.FolderExists(strFolder) Then
            EnumFolders = False
            Exit Function
        End If
 
        Dim fCallBack
        Dim SubFolders, SubFolder, ChildFolders, ChildFolder
 
        Set fCallBack = GetRef(fCallBackName)
        Set SubFolders = GetSubFolders(strFolder)
        For Each SubFolder In SubFolders
            If fCallBack(Me, AxFile, SubFolder, Param) Then Exit For
            If Recursion Then
                Set ChildFolders = SubFolder.SubFolders
                For Each ChildFolder In ChildFolders
                    If fCallBack(Me, AxFile, ChildFolder, Param) Then Exit For
                    Call EnumFolders(AxFile.GetAbsolutePathName(ChildFolder), _
                              fCallBackName, Recursion, Param)
                Next
                Set ChildFolders = Nothing
            End If
        Next
        Set SubFolders = Nothing
        Set fCallBack = Nothing
    End Function
End Class
 
' Example:
' Function ParseFiles(self, fso, file, param)
'     WSH.Echo file.Name & " at " & fso.GetAbsolutePathName(file)
' End Function
' Dim fp
' Set fp = New FileOperation
'     fp.EnumFiles "C:\", "ParseFiles", True, Null
' Set fp = Nothing
若无特别说明，本网站文章均为原创，原则上这些文章不允许转载，但是如果阁下是出于研究学习目的可以转载到阁下的个人博客或者主页，转载遵循创作共同性“署名-非商业性使用-相同方式共享”原则，请转载时注明作者和出处，谢绝商业性、非署名、采集站、垃圾站或者纯粹为了流量的转载。谢谢合作！

您可能喜欢

请稍后...

发表评论

电子邮件地址不会被公开。 必填项已用*标注

CAPTCHA

*

This site uses Akismet to reduce spam. Learn how your comment data is processed.