migrationanalysis/src/driver_docs/sources/CollectedFiles.cls

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