xref: /trunk/main/migrationanalysis/src/driver_docs/sources/CollectedFiles.cls (revision d4a3fa4b)

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
'*************************************************************************
'
'  Licensed to the Apache Software Foundation (ASF) under one
'  or more contributor license agreements.  See the NOTICE file
'  distributed with this work for additional information
'  regarding copyright ownership.  The ASF licenses this file
'  to you under the Apache License, Version 2.0 (the
'  "License"); you may not use this file except in compliance
'  with the License.  You may obtain a copy of the License at
'
'    http://www.apache.org/licenses/LICENSE-2.0
'
'  Unless required by applicable law or agreed to in writing,
'  software distributed under the License is distributed on an
'  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
'  KIND, either express or implied.  See the License for the
'  specific language governing permissions and limitations
'  under the 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