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