VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "CollectedFiles" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False '/************************************************************************* ' * ' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. ' ' Copyright 2000, 2010 Oracle and/or its affiliates. ' ' OpenOffice.org - a multi-platform office productivity suite ' ' This file is part of OpenOffice.org. ' ' OpenOffice.org is free software: you can redistribute it and/or modify ' it under the terms of the GNU Lesser General Public License version 3 ' only, as published by the Free Software Foundation. ' ' OpenOffice.org is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY; without even the implied warranty of ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU Lesser General Public License version 3 for more details ' (a copy is included in the LICENSE file that accompanied this code). ' ' You should have received a copy of the GNU Lesser General Public License ' version 3 along with OpenOffice.org. If not, see ' ' for a copy of the LGPLv3 License. ' ' ************************************************************************/ Option Explicit Private Const vbDot = 46 Private Const MAX_PATH = 260 Private Const INVALID_HANDLE_VALUE = -1 Private Const vbBackslash = "\" Private Const ALL_FILES = "*.*" Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Private Type FILE_PARAMS bRecurse As Boolean nSearched As Long sFileNameExt As String sFileRoot As String End Type Private Declare Function FindClose Lib "kernel32" _ (ByVal hFindFile As Long) As Long Private Declare Function FindFirstFile Lib "kernel32" _ Alias "FindFirstFileA" _ (ByVal lpFileName As String, _ lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindNextFile Lib "kernel32" _ Alias "FindNextFileA" _ (ByVal hFindFile As Long, _ lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function GetTickCount Lib "kernel32" () As Long Private Declare Function lstrlen Lib "kernel32" _ Alias "lstrlenW" (ByVal lpString As Long) As Long Private Declare Function PathMatchSpec Lib "shlwapi" _ Alias "PathMatchSpecW" _ (ByVal pszFileParam As Long, _ ByVal pszSpec As Long) As Long Private fp As FILE_PARAMS 'holds search parameters Private mWordFilesCol As Collection Private mExcelFilesCol As Collection Private mPPFilesCol As Collection Private mDocCount As Long Private mDotCount As Long Private mXlsCount As Long Private mXltCount As Long Private mPptCount As Long Private mPotCount As Long Private mbDocSearch As Boolean Private mbDotSearch As Boolean Private mbXlsSearch As Boolean Private mbXltSearch As Boolean Private mbPptSearch As Boolean Private mbPotSearch As Boolean Private mBannedList As Collection Private Sub Class_Initialize() Set mWordFilesCol = New Collection Set mExcelFilesCol = New Collection Set mPPFilesCol = New Collection Set mBannedList = New Collection End Sub Private Sub Class_Terminate() Set mWordFilesCol = Nothing Set mExcelFilesCol = Nothing Set mPPFilesCol = Nothing Set mBannedList = Nothing End Sub Public Property Get BannedList() As Collection Set BannedList = mBannedList End Property Public Property Let BannedList(ByVal theList As Collection) Set mBannedList = theList End Property Public Property Get DocCount() As Long DocCount = mDocCount End Property Public Property Get DotCount() As Long DotCount = mDotCount End Property Public Property Get XlsCount() As Long XlsCount = mXlsCount End Property Public Property Get XltCount() As Long XltCount = mXltCount End Property Public Property Get PptCount() As Long PptCount = mPptCount End Property Public Property Get PotCount() As Long PotCount = mPotCount End Property Public Property Get WordFiles() As Collection Set WordFiles = mWordFilesCol End Property Public Property Get ExcelFiles() As Collection Set ExcelFiles = mExcelFilesCol End Property Public Property Get PowerPointFiles() As Collection Set PowerPointFiles = mPPFilesCol End Property Public Function count() As Long count = mWordFilesCol.count + mExcelFilesCol.count + mPPFilesCol.count End Function Public Function Search(rootDir As String, _ FileSpecs As Collection, IncludeSubdirs As Boolean) On Error GoTo HandleErrors Dim currentFunctionName As String currentFunctionName = "Search" Dim tstart As Single 'timer var for this routine only Dim tend As Single 'timer var for this routine only Dim spec As Variant Dim allSpecs As String Dim fso As New FileSystemObject If FileSpecs.count = 0 Then Exit Function If FileSpecs.count > 1 Then For Each spec In FileSpecs allSpecs = allSpecs & "; " & spec SetSearchBoolean CStr(spec) Next Else allSpecs = FileSpecs(1) SetSearchBoolean CStr(FileSpecs(1)) End If With fp .sFileRoot = QualifyPath(rootDir) .sFileNameExt = allSpecs .bRecurse = IncludeSubdirs .nSearched = 0 End With tstart = GetTickCount() Call SearchForFiles(fp.sFileRoot) tend = GetTickCount() 'Debug: 'MsgBox "Specs " & allSpecs & vbLf & _ ' Format$(fp.nSearched, "###,###,###,##0") & vbLf & _ ' Format$(count, "###,###,###,##0") & vbLf & _ ' FormatNumber((tend - tstart) / 1000, 2) & " seconds" FinalExit: Set fso = Nothing Exit Function HandleErrors: WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source Resume FinalExit End Function Function isBannedFile(thePath As String) As Boolean Dim aPath As Variant Dim theResult As Boolean theResult = False For Each aPath In mBannedList If aPath = thePath Then theResult = True GoTo FinalExit End If Next FinalExit: isBannedFile = theResult End Function Sub SetSearchBoolean(spec As String) If spec = "*.doc" Then mbDocSearch = True End If If spec = "*.dot" Then mbDotSearch = True End If If spec = "*.xls" Then mbXlsSearch = True End If If spec = "*.xlt" Then mbXltSearch = True End If If spec = "*.ppt" Then mbPptSearch = True End If If spec = "*.pot" Then mbPotSearch = True End If End Sub Private Sub SearchForFiles(sRoot As String) On Error GoTo HandleErrors Dim currentFunctionName As String currentFunctionName = "SearchForFiles" Dim WFD As WIN32_FIND_DATA Dim hFile As Long Dim path As String Dim WordDriverPathTemp As String Dim ExcelDriverPathTemp As String Dim PPDriverPathTemp As String hFile = FindFirstFile(sRoot & ALL_FILES, WFD) If hFile = INVALID_HANDLE_VALUE Then GoTo FinalExit Do 'if a folder, and recurse specified, call 'method again If (WFD.dwFileAttributes And vbDirectory) Then If Asc(WFD.cFileName) <> vbDot Then If fp.bRecurse Then SearchForFiles sRoot & TrimNull(WFD.cFileName) & vbBackslash End If End If Else 'must be a file.. If mbDocSearch Then If MatchSpec(WFD.cFileName, "*.doc") Then path = sRoot & TrimNull(WFD.cFileName) 'If StrComp(path, mWordDriverPath, vbTextCompare) <> 0 Then If Not isBannedFile(path) Then mDocCount = mDocCount + 1 mWordFilesCol.Add path GoTo CONTINUE_LOOP End If End If End If If mbDotSearch Then If MatchSpec(WFD.cFileName, "*.dot") Then mDotCount = mDotCount + 1 mWordFilesCol.Add sRoot & TrimNull(WFD.cFileName) GoTo CONTINUE_LOOP End If End If If mbXlsSearch Then If MatchSpec(WFD.cFileName, "*.xls") Then path = sRoot & TrimNull(WFD.cFileName) 'If StrComp(TrimNull(WFD.cFileName), CEXCEL_DRIVER_FILE, vbTextCompare) <> 0 Then If Not isBannedFile(path) Then mXlsCount = mXlsCount + 1 mExcelFilesCol.Add sRoot & TrimNull(WFD.cFileName) GoTo CONTINUE_LOOP End If End If End If If mbXltSearch Then If MatchSpec(WFD.cFileName, "*.xlt") Then mXltCount = mXltCount + 1 mExcelFilesCol.Add sRoot & TrimNull(WFD.cFileName) GoTo CONTINUE_LOOP End If End If If mbPptSearch Then If MatchSpec(WFD.cFileName, "*.ppt") Then path = sRoot & TrimNull(WFD.cFileName) 'If StrComp(path, mPPDriverPath, vbTextCompare) <> 0 Then If Not isBannedFile(path) Then mPptCount = mPptCount + 1 mPPFilesCol.Add path GoTo CONTINUE_LOOP End If End If End If If mbPotSearch Then If MatchSpec(WFD.cFileName, "*.pot") Then mPotCount = mPotCount + 1 mPPFilesCol.Add sRoot & TrimNull(WFD.cFileName) GoTo CONTINUE_LOOP End If End If End If 'If WFD.dwFileAttributes CONTINUE_LOOP: fp.nSearched = fp.nSearched + 1 Loop While FindNextFile(hFile, WFD) FinalExit: Call FindClose(hFile) Exit Sub HandleErrors: WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source Resume FinalExit End Sub Private Function QualifyPath(sPath As String) As String If Right$(sPath, 1) <> vbBackslash Then QualifyPath = sPath & vbBackslash Else: QualifyPath = sPath End If End Function Private Function TrimNull(startstr As String) As String TrimNull = Left$(startstr, lstrlen(StrPtr(startstr))) End Function Private Function MatchSpec(sFile As String, sSpec As String) As Boolean MatchSpec = PathMatchSpec(StrPtr(sFile), StrPtr(sSpec)) End Function