1VERSION 1.0 CLASS 2BEGIN 3 MultiUse = -1 'True 4END 5Attribute VB_Name = "CollectedFiles" 6Attribute VB_GlobalNameSpace = False 7Attribute VB_Creatable = False 8Attribute VB_PredeclaredId = False 9Attribute VB_Exposed = False 10'************************************************************************* 11' 12' Licensed to the Apache Software Foundation (ASF) under one 13' or more contributor license agreements. See the NOTICE file 14' distributed with this work for additional information 15' regarding copyright ownership. The ASF licenses this file 16' to you under the Apache License, Version 2.0 (the 17' "License"); you may not use this file except in compliance 18' with the License. You may obtain a copy of the License at 19' 20' http://www.apache.org/licenses/LICENSE-2.0 21' 22' Unless required by applicable law or agreed to in writing, 23' software distributed under the License is distributed on an 24' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 25' KIND, either express or implied. See the License for the 26' specific language governing permissions and limitations 27' under the License. 28' 29'************************************************************************* 30Option Explicit 31 32Private Const vbDot = 46 33Private Const MAX_PATH = 260 34Private Const INVALID_HANDLE_VALUE = -1 35Private Const vbBackslash = "\" 36Private Const ALL_FILES = "*.*" 37 38Private Type FILETIME 39 dwLowDateTime As Long 40 dwHighDateTime As Long 41End Type 42 43Private Type WIN32_FIND_DATA 44 dwFileAttributes As Long 45 ftCreationTime As FILETIME 46 ftLastAccessTime As FILETIME 47 ftLastWriteTime As FILETIME 48 nFileSizeHigh As Long 49 nFileSizeLow As Long 50 dwReserved0 As Long 51 dwReserved1 As Long 52 cFileName As String * MAX_PATH 53 cAlternate As String * 14 54End Type 55 56Private Type FILE_PARAMS 57 bRecurse As Boolean 58 nSearched As Long 59 sFileNameExt As String 60 sFileRoot As String 61End Type 62 63Private Declare Function FindClose Lib "kernel32" _ 64 (ByVal hFindFile As Long) As Long 65 66Private Declare Function FindFirstFile Lib "kernel32" _ 67 Alias "FindFirstFileA" _ 68 (ByVal lpFileName As String, _ 69 lpFindFileData As WIN32_FIND_DATA) As Long 70 71Private Declare Function FindNextFile Lib "kernel32" _ 72 Alias "FindNextFileA" _ 73 (ByVal hFindFile As Long, _ 74 lpFindFileData As WIN32_FIND_DATA) As Long 75 76Private Declare Function GetTickCount Lib "kernel32" () As Long 77 78Private Declare Function lstrlen Lib "kernel32" _ 79 Alias "lstrlenW" (ByVal lpString As Long) As Long 80 81Private Declare Function PathMatchSpec Lib "shlwapi" _ 82 Alias "PathMatchSpecW" _ 83 (ByVal pszFileParam As Long, _ 84 ByVal pszSpec As Long) As Long 85 86Private fp As FILE_PARAMS 'holds search parameters 87 88Private mWordFilesCol As Collection 89Private mExcelFilesCol As Collection 90Private mPPFilesCol As Collection 91 92Private mDocCount As Long 93Private mDotCount As Long 94Private mXlsCount As Long 95Private mXltCount As Long 96Private mPptCount As Long 97Private mPotCount As Long 98Private mbDocSearch As Boolean 99Private mbDotSearch As Boolean 100Private mbXlsSearch As Boolean 101Private mbXltSearch As Boolean 102Private mbPptSearch As Boolean 103Private mbPotSearch As Boolean 104 105Private mBannedList As Collection 106 107Private Sub Class_Initialize() 108 Set mWordFilesCol = New Collection 109 Set mExcelFilesCol = New Collection 110 Set mPPFilesCol = New Collection 111 Set mBannedList = New Collection 112End Sub 113Private Sub Class_Terminate() 114 Set mWordFilesCol = Nothing 115 Set mExcelFilesCol = Nothing 116 Set mPPFilesCol = Nothing 117 Set mBannedList = Nothing 118End Sub 119 120Public Property Get BannedList() As Collection 121 Set BannedList = mBannedList 122End Property 123Public Property Let BannedList(ByVal theList As Collection) 124 Set mBannedList = theList 125End Property 126 127Public Property Get DocCount() As Long 128 DocCount = mDocCount 129End Property 130Public Property Get DotCount() As Long 131 DotCount = mDotCount 132End Property 133Public Property Get XlsCount() As Long 134 XlsCount = mXlsCount 135End Property 136Public Property Get XltCount() As Long 137 XltCount = mXltCount 138End Property 139Public Property Get PptCount() As Long 140 PptCount = mPptCount 141End Property 142Public Property Get PotCount() As Long 143 PotCount = mPotCount 144End Property 145 146Public Property Get WordFiles() As Collection 147 Set WordFiles = mWordFilesCol 148End Property 149Public Property Get ExcelFiles() As Collection 150 Set ExcelFiles = mExcelFilesCol 151End Property 152Public Property Get PowerPointFiles() As Collection 153 Set PowerPointFiles = mPPFilesCol 154End Property 155 156Public Function count() As Long 157 count = mWordFilesCol.count + mExcelFilesCol.count + mPPFilesCol.count 158End Function 159 160 161Public Function Search(rootDir As String, _ 162 FileSpecs As Collection, IncludeSubdirs As Boolean) 163 On Error GoTo HandleErrors 164 Dim currentFunctionName As String 165 currentFunctionName = "Search" 166 167 Dim tstart As Single 'timer var for this routine only 168 Dim tend As Single 'timer var for this routine only 169 Dim spec As Variant 170 Dim allSpecs As String 171 Dim fso As New FileSystemObject 172 173 If FileSpecs.count = 0 Then Exit Function 174 175 If FileSpecs.count > 1 Then 176 For Each spec In FileSpecs 177 allSpecs = allSpecs & "; " & spec 178 SetSearchBoolean CStr(spec) 179 Next 180 Else 181 allSpecs = FileSpecs(1) 182 SetSearchBoolean CStr(FileSpecs(1)) 183 End If 184 185 With fp 186 .sFileRoot = QualifyPath(rootDir) 187 .sFileNameExt = allSpecs 188 .bRecurse = IncludeSubdirs 189 .nSearched = 0 190 End With 191 192 tstart = GetTickCount() 193 Call SearchForFiles(fp.sFileRoot) 194 tend = GetTickCount() 195 196 'Debug: 197 'MsgBox "Specs " & allSpecs & vbLf & _ 198 ' Format$(fp.nSearched, "###,###,###,##0") & vbLf & _ 199 ' Format$(count, "###,###,###,##0") & vbLf & _ 200 ' FormatNumber((tend - tstart) / 1000, 2) & " seconds" 201 202FinalExit: 203 Set fso = Nothing 204 Exit Function 205 206HandleErrors: 207 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 208 Resume FinalExit 209End Function 210Function isBannedFile(thePath As String) As Boolean 211 212 Dim aPath As Variant 213 Dim theResult As Boolean 214 theResult = False 215 For Each aPath In mBannedList 216 If aPath = thePath Then 217 theResult = True 218 GoTo FinalExit 219 End If 220 Next 221 222FinalExit: 223 isBannedFile = theResult 224End Function 225Sub SetSearchBoolean(spec As String) 226 227 If spec = "*.doc" Then 228 mbDocSearch = True 229 End If 230 If spec = "*.dot" Then 231 mbDotSearch = True 232 End If 233 If spec = "*.xls" Then 234 mbXlsSearch = True 235 End If 236 If spec = "*.xlt" Then 237 mbXltSearch = True 238 End If 239 If spec = "*.ppt" Then 240 mbPptSearch = True 241 End If 242 If spec = "*.pot" Then 243 mbPotSearch = True 244 End If 245 246End Sub 247 248Private Sub SearchForFiles(sRoot As String) 249 On Error GoTo HandleErrors 250 Dim currentFunctionName As String 251 currentFunctionName = "SearchForFiles" 252 253 Dim WFD As WIN32_FIND_DATA 254 Dim hFile As Long 255 Dim path As String 256 Dim WordDriverPathTemp As String 257 Dim ExcelDriverPathTemp As String 258 Dim PPDriverPathTemp As String 259 260 hFile = FindFirstFile(sRoot & ALL_FILES, WFD) 261 262 If hFile = INVALID_HANDLE_VALUE Then GoTo FinalExit 263 264 Do 265 'if a folder, and recurse specified, call 266 'method again 267 If (WFD.dwFileAttributes And vbDirectory) Then 268 If Asc(WFD.cFileName) <> vbDot Then 269 If fp.bRecurse Then 270 SearchForFiles sRoot & TrimNull(WFD.cFileName) & vbBackslash 271 End If 272 End If 273 Else 274 'must be a file.. 275 If mbDocSearch Then 276 If MatchSpec(WFD.cFileName, "*.doc") Then 277 path = sRoot & TrimNull(WFD.cFileName) 278 'If StrComp(path, mWordDriverPath, vbTextCompare) <> 0 Then 279 If Not isBannedFile(path) Then 280 mDocCount = mDocCount + 1 281 mWordFilesCol.Add path 282 GoTo CONTINUE_LOOP 283 End If 284 End If 285 End If 286 If mbDotSearch Then 287 If MatchSpec(WFD.cFileName, "*.dot") Then 288 mDotCount = mDotCount + 1 289 mWordFilesCol.Add sRoot & TrimNull(WFD.cFileName) 290 GoTo CONTINUE_LOOP 291 End If 292 End If 293 If mbXlsSearch Then 294 If MatchSpec(WFD.cFileName, "*.xls") Then 295 path = sRoot & TrimNull(WFD.cFileName) 296 'If StrComp(TrimNull(WFD.cFileName), CEXCEL_DRIVER_FILE, vbTextCompare) <> 0 Then 297 If Not isBannedFile(path) Then 298 mXlsCount = mXlsCount + 1 299 mExcelFilesCol.Add sRoot & TrimNull(WFD.cFileName) 300 GoTo CONTINUE_LOOP 301 End If 302 End If 303 End If 304 If mbXltSearch Then 305 If MatchSpec(WFD.cFileName, "*.xlt") Then 306 mXltCount = mXltCount + 1 307 mExcelFilesCol.Add sRoot & TrimNull(WFD.cFileName) 308 GoTo CONTINUE_LOOP 309 End If 310 End If 311 If mbPptSearch Then 312 If MatchSpec(WFD.cFileName, "*.ppt") Then 313 path = sRoot & TrimNull(WFD.cFileName) 314 'If StrComp(path, mPPDriverPath, vbTextCompare) <> 0 Then 315 If Not isBannedFile(path) Then 316 mPptCount = mPptCount + 1 317 mPPFilesCol.Add path 318 GoTo CONTINUE_LOOP 319 End If 320 End If 321 End If 322 If mbPotSearch Then 323 If MatchSpec(WFD.cFileName, "*.pot") Then 324 mPotCount = mPotCount + 1 325 mPPFilesCol.Add sRoot & TrimNull(WFD.cFileName) 326 GoTo CONTINUE_LOOP 327 End If 328 End If 329 330 End If 'If WFD.dwFileAttributes 331 332CONTINUE_LOOP: 333 fp.nSearched = fp.nSearched + 1 334 335 Loop While FindNextFile(hFile, WFD) 336 337FinalExit: 338 Call FindClose(hFile) 339 Exit Sub 340 341HandleErrors: 342 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 343 Resume FinalExit 344End Sub 345 346 347Private Function QualifyPath(sPath As String) As String 348 349 If Right$(sPath, 1) <> vbBackslash Then 350 QualifyPath = sPath & vbBackslash 351 Else: QualifyPath = sPath 352 End If 353 354End Function 355 356 357Private Function TrimNull(startstr As String) As String 358 359 TrimNull = Left$(startstr, lstrlen(StrPtr(startstr))) 360 361End Function 362 363 364Private Function MatchSpec(sFile As String, sSpec As String) As Boolean 365 366 MatchSpec = PathMatchSpec(StrPtr(sFile), StrPtr(sSpec)) 367 368End Function 369 370 371 372 373