1VERSION 1.0 CLASS 2BEGIN 3 MultiUse = -1 'True 4 Persistable = 0 'NotPersistable 5 DataBindingBehavior = 0 'vbNone 6 DataSourceBehavior = 0 'vbNone 7 MTSTransactionMode = 0 'NotAnMTSObject 8END 9Attribute VB_Name = "CollectedFiles" 10Attribute VB_GlobalNameSpace = False 11Attribute VB_Creatable = True 12Attribute VB_PredeclaredId = False 13Attribute VB_Exposed = False 14'/************************************************************************* 15' * 16' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. 17' 18' Copyright 2000, 2010 Oracle and/or its affiliates. 19' 20' OpenOffice.org - a multi-platform office productivity suite 21' 22' This file is part of OpenOffice.org. 23' 24' OpenOffice.org is free software: you can redistribute it and/or modify 25' it under the terms of the GNU Lesser General Public License version 3 26' only, as published by the Free Software Foundation. 27' 28' OpenOffice.org is distributed in the hope that it will be useful, 29' but WITHOUT ANY WARRANTY; without even the implied warranty of 30' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 31' GNU Lesser General Public License version 3 for more details 32' (a copy is included in the LICENSE file that accompanied this code). 33' 34' You should have received a copy of the GNU Lesser General Public License 35' version 3 along with OpenOffice.org. If not, see 36' <http://www.openoffice.org/license.html> 37' for a copy of the LGPLv3 License. 38' 39' ************************************************************************/ 40Option Explicit 41 42Private Const vbDot = 46 43Private Const MAX_PATH = 260 44Private Const INVALID_HANDLE_VALUE = -1 45Private Const vbBackslash = "\" 46Private Const ALL_FILES = "*.*" 47 48Private Type FILETIME 49 dwLowDateTime As Long 50 dwHighDateTime As Long 51End Type 52 53Private Type SYSTEMTIME 54 wYear As Integer 55 wMonth As Integer 56 wDayOfWeek As Integer 57 wDay As Integer 58 wHour As Integer 59 wMinute As Integer 60 wSecond As Integer 61 wMilliseconds As Integer 62End Type 63 64Private Type WIN32_FIND_DATA 65 dwFileAttributes As Long 66 ftCreationTime As FILETIME 67 ftLastAccessTime As FILETIME 68 ftLastWriteTime As FILETIME 69 nFileSizeHigh As Long 70 nFileSizeLow As Long 71 dwReserved0 As Long 72 dwReserved1 As Long 73 cFileName As String * MAX_PATH 74 cAlternate As String * 14 75End Type 76 77Private Type FILE_PARAMS 78 bRecurse As Boolean 79 nSearched As Long 80 sFileNameExt As String 81 sFileRoot As String 82End Type 83 84Private Declare Function SystemTimeToFileTime Lib "kernel32" _ 85 (lpSystemTime As SYSTEMTIME, _ 86 lpFileTime As FILETIME) As Long 87 88Private Declare Function CompareFileTime Lib "kernel32" _ 89 (lpFileTime1 As FILETIME, _ 90 lpFileTime2 As FILETIME) As Long 91 92Private Declare Function FindClose Lib "kernel32" _ 93 (ByVal hFindFile As Long) As Long 94 95Private Declare Function FindFirstFile Lib "kernel32" _ 96 Alias "FindFirstFileA" _ 97 (ByVal lpFileName As String, _ 98 lpFindFileData As WIN32_FIND_DATA) As Long 99 100Private Declare Function FindNextFile Lib "kernel32" _ 101 Alias "FindNextFileA" _ 102 (ByVal hFindFile As Long, _ 103 lpFindFileData As WIN32_FIND_DATA) As Long 104 105Private Declare Function GetTickCount Lib "kernel32" () As Long 106 107Private Declare Function lstrlen Lib "kernel32" _ 108 Alias "lstrlenW" (ByVal lpString As Long) As Long 109 110Private Declare Function PathMatchSpec Lib "shlwapi" _ 111 Alias "PathMatchSpecW" _ 112 (ByVal pszFileParam As Long, _ 113 ByVal pszSpec As Long) As Long 114 115Private fp As FILE_PARAMS 'holds search parameters 116 117Private mWordFilesCol As Collection 118Private mExcelFilesCol As Collection 119Private mPPFilesCol As Collection 120 121Private mLessThan3 As Long 122Private mLessThan6 As Long 123Private mLessThan12 As Long 124Private mMoreThan12 As Long 125Private m3Months As FILETIME 126Private m6Months As FILETIME 127Private m12Months As FILETIME 128 129Private mDocCount As Long 130Private mDotCount As Long 131Private mXlsCount As Long 132Private mXltCount As Long 133Private mPptCount As Long 134Private mPotCount As Long 135Private mIgnoredDocs As Long 136Private mbDocSearch As Boolean 137Private mbDotSearch As Boolean 138Private mbXlsSearch As Boolean 139Private mbXltSearch As Boolean 140Private mbPptSearch As Boolean 141Private mbPotSearch As Boolean 142 143Private mWordDriverPath As String 144Private mExcelDriverPath As String 145Private mPPDriverPath As String 146 147Private Sub Class_Initialize() 148 Set mWordFilesCol = New Collection 149 Set mExcelFilesCol = New Collection 150 Set mPPFilesCol = New Collection 151End Sub 152Private Sub Class_Terminate() 153 Set mWordFilesCol = Nothing 154 Set mExcelFilesCol = Nothing 155 Set mPPFilesCol = Nothing 156End Sub 157 158Public Property Get DocCount() As Long 159 DocCount = mDocCount 160End Property 161Public Property Get DotCount() As Long 162 DotCount = mDotCount 163End Property 164Public Property Get XlsCount() As Long 165 XlsCount = mXlsCount 166End Property 167Public Property Get XltCount() As Long 168 XltCount = mXltCount 169End Property 170Public Property Get PptCount() As Long 171 PptCount = mPptCount 172End Property 173Public Property Get PotCount() As Long 174 PotCount = mPotCount 175End Property 176Public Property Get IgnoredDocCount() As Long 177 IgnoredDocCount = mIgnoredDocs 178End Property 179Public Property Get DocsLessThan3Months() As Long 180 DocsLessThan3Months = mLessThan3 181End Property 182Public Property Get DocsLessThan6Months() As Long 183 DocsLessThan6Months = mLessThan6 184End Property 185Public Property Get DocsLessThan12Months() As Long 186 DocsLessThan12Months = mLessThan12 187End Property 188Public Property Get DocsMoreThan12Months() As Long 189 DocsMoreThan12Months = mMoreThan12 190End Property 191 192Public Property Get WordFiles() As Collection 193 Set WordFiles = mWordFilesCol 194End Property 195Public Property Get ExcelFiles() As Collection 196 Set ExcelFiles = mExcelFilesCol 197End Property 198Public Property Get PowerPointFiles() As Collection 199 Set PowerPointFiles = mPPFilesCol 200End Property 201 202Public Function count() As Long 203 count = mWordFilesCol.count + mExcelFilesCol.count + mPPFilesCol.count 204End Function 205 206Public Function Search(rootDir As String, FileSpecs As Collection, IncludeSubdirs As Boolean, _ 207 ignoreOld As Boolean, Months As Integer) As Boolean 208 On Error GoTo HandleErrors 209 Dim currentFunctionName As String 210 currentFunctionName = "Search" 211 212 Dim tstart As Single 'timer var for this routine only 213 Dim tend As Single 'timer var for this routine only 214 Dim spec As Variant 215 Dim allSpecs As String 216 Dim fso As New FileSystemObject 217 218 Search = True 219 220 If FileSpecs.count = 0 Then Exit Function 221 222 If FileSpecs.count > 1 Then 223 For Each spec In FileSpecs 224 allSpecs = allSpecs & "; " & spec 225 SetSearchBoolean CStr(spec) 226 Next 227 Else 228 allSpecs = FileSpecs(1) 229 SetSearchBoolean CStr(FileSpecs(1)) 230 End If 231 232 mWordDriverPath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CWORD_DRIVER_FILE) 233 mExcelDriverPath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CEXCEL_DRIVER_FILE) 234 mPPDriverPath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CPP_DRIVER_FILE) 235 236 With fp 237 .sFileRoot = QualifyPath(rootDir) 238 .sFileNameExt = allSpecs 239 .bRecurse = IncludeSubdirs 240 .nSearched = 0 241 End With 242 243 Load SearchDocs 244 245 ignoreOld = ignoreOld And InitFileTimes 246 247 Dim limDate As FILETIME 248 If ignoreOld Then 249 If Months = 3 Then 250 limDate = m3Months 251 ElseIf Months = 6 Then 252 limDate = m6Months 253 ElseIf Months = 12 Then 254 limDate = m12Months 255 Else 256 ignoreOld = False 257 End If 258 End If 259 260 'tstart = GetTickCount() 261 Search = SearchForFiles(QualifyPath(rootDir), IncludeSubdirs, ignoreOld, limDate) 262 'tend = GetTickCount() 263 264 Unload SearchDocs 265 266 'Debug: 267 'MsgBox "Specs " & allSpecs & vbLf & _ 268 ' Format$(fp.nSearched, "###,###,###,##0") & vbLf & _ 269 ' Format$(count, "###,###,###,##0") & vbLf & _ 270 ' FormatNumber((tend - tstart) / 1000, 2) & " seconds" 271 272FinalExit: 273 Set fso = Nothing 274 Exit Function 275 276HandleErrors: 277 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 278 Resume FinalExit 279End Function 280Sub SetSearchBoolean(spec As String) 281 282 If spec = "*.doc" Then 283 mbDocSearch = True 284 End If 285 If spec = "*.dot" Then 286 mbDotSearch = True 287 End If 288 If spec = "*.xls" Then 289 mbXlsSearch = True 290 End If 291 If spec = "*.xlt" Then 292 mbXltSearch = True 293 End If 294 If spec = "*.ppt" Then 295 mbPptSearch = True 296 End If 297 If spec = "*.pot" Then 298 mbPotSearch = True 299 End If 300 301End Sub 302 303Private Function SearchForFiles(sRoot As String, bRecurse As Boolean, _ 304 bIgnoreOld As Boolean, limDate As FILETIME) As Boolean 305 On Error GoTo HandleErrors 306 Dim currentFunctionName As String 307 currentFunctionName = "SearchForFiles" 308 309 Dim WFD As WIN32_FIND_DATA 310 Dim hFile As Long 311 Dim path As String 312 Dim sFileName As String 313 Dim nTotal As Long 314 315 SearchForFiles = False 316 317 hFile = FindFirstFile(sRoot & ALL_FILES, WFD) 318 319 If hFile = INVALID_HANDLE_VALUE Then GoTo FinalExit 320 321 Do 322 If (SearchDocs.g_SD_Abort) Then GoTo FinalExit 323 sFileName = TrimNull(WFD.cFileName) 324 'if a folder, and recurse specified, call 325 'method again 326 If (WFD.dwFileAttributes And vbDirectory) Then 327 If (Asc(WFD.cFileName) <> vbDot) And bRecurse Then 328 SearchForFiles sRoot & sFileName & vbBackslash, bRecurse, bIgnoreOld, limDate 329 End If 330 Else 331 'must be a file.. 332 nTotal = mDocCount + mDotCount + mXlsCount + _ 333 mXltCount + mPptCount + mPotCount 334 SearchDocs.SD_UpdateProgress str$(nTotal), sRoot 335 DoEvents 336 337 If mbDocSearch Then 338 If MatchSpec(WFD.cFileName, "*.doc") Then 339 path = sRoot & sFileName 340 341 'If StrComp(path, mWordDriverPath, vbTextCompare) <> 0 Then 342 If Not MatchSpec(path, mWordDriverPath) Then 343 If (IsTooOld(WFD, limDate, bIgnoreOld)) Then 344 mIgnoredDocs = mIgnoredDocs + 1 345 Else 346 mDocCount = mDocCount + 1 347 mWordFilesCol.add path 348 End If 349 End If 350 GoTo CONTINUE_LOOP 351 End If 352 End If 353 If mbDotSearch Then 354 If MatchSpec(WFD.cFileName, "*.dot") Then 355 If (IsTooOld(WFD, limDate, bIgnoreOld)) Then 356 mIgnoredDocs = mIgnoredDocs + 1 357 Else 358 mDotCount = mDotCount + 1 359 mWordFilesCol.add sRoot & sFileName 360 End If 361 GoTo CONTINUE_LOOP 362 End If 363 End If 364 If mbXlsSearch Then 365 If MatchSpec(WFD.cFileName, "*.xls") Then 366 'If StrComp(sFileName, CEXCEL_DRIVER_FILE, vbTextCompare) <> 0 Then 367 If Not MatchSpec(WFD.cFileName, CEXCEL_DRIVER_FILE) Then 368 If (IsTooOld(WFD, limDate, bIgnoreOld)) Then 369 mIgnoredDocs = mIgnoredDocs + 1 370 Else 371 mXlsCount = mXlsCount + 1 372 mExcelFilesCol.add sRoot & sFileName 373 End If 374 End If 375 GoTo CONTINUE_LOOP 376 End If 377 End If 378 If mbXltSearch Then 379 If MatchSpec(WFD.cFileName, "*.xlt") Then 380 If (IsTooOld(WFD, limDate, bIgnoreOld)) Then 381 mIgnoredDocs = mIgnoredDocs + 1 382 Else 383 mXltCount = mXltCount + 1 384 mExcelFilesCol.add sRoot & sFileName 385 End If 386 GoTo CONTINUE_LOOP 387 End If 388 End If 389 If mbPptSearch Then 390 If MatchSpec(WFD.cFileName, "*.ppt") Then 391 path = sRoot & sFileName 392 'If StrComp(path, mPPDriverPath, vbTextCompare) <> 0 Then 393 If Not MatchSpec(path, mPPDriverPath) Then 394 If (IsTooOld(WFD, limDate, bIgnoreOld)) Then 395 mIgnoredDocs = mIgnoredDocs + 1 396 Else 397 mPptCount = mPptCount + 1 398 mPPFilesCol.add path 399 End If 400 End If 401 GoTo CONTINUE_LOOP 402 End If 403 End If 404 If mbPotSearch Then 405 If MatchSpec(WFD.cFileName, "*.pot") Then 406 If (IsTooOld(WFD, limDate, bIgnoreOld)) Then 407 mIgnoredDocs = mIgnoredDocs + 1 408 Else 409 mPotCount = mPotCount + 1 410 mPPFilesCol.add sRoot & sFileName 411 End If 412 GoTo CONTINUE_LOOP 413 End If 414 End If 415 416 End If 'If WFD.dwFileAttributes 417 418CONTINUE_LOOP: 419 fp.nSearched = fp.nSearched + 1 420 421 Loop While FindNextFile(hFile, WFD) 422 423 SearchForFiles = True 424FinalExit: 425 Call FindClose(hFile) 426 Exit Function 427 428HandleErrors: 429 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 430 Resume FinalExit 431End Function 432 433Private Function QualifyPath(sPath As String) As String 434 435 If Right$(sPath, 1) <> vbBackslash Then 436 QualifyPath = sPath & vbBackslash 437 Else: QualifyPath = sPath 438 End If 439 440End Function 441 442Private Function TrimNull(startstr As String) As String 443 444 TrimNull = Left$(startstr, lstrlen(StrPtr(startstr))) 445 446End Function 447 448Private Function MatchSpec(sFile As String, sSpec As String) As Boolean 449 450 MatchSpec = PathMatchSpec(StrPtr(sFile), StrPtr(sSpec)) 451 452End Function 453 454Private Function IsTooOld(aWFD As WIN32_FIND_DATA, minDate As FILETIME, _ 455 ignoreOld As Boolean) As Boolean 456 457 IsTooOld = False 458 459 Dim aFileTime As FILETIME 460 461 If (aWFD.ftLastWriteTime.dwHighDateTime <> 0) Then 462 aFileTime = aWFD.ftLastWriteTime 463 ElseIf (aWFD.ftCreationTime.dwHighDateTime <> 0) Then 464 aFileTime = aWFD.ftCreationTime 465 Else 466 ' No valid time found, don't ignore file 467 mLessThan3 = mLessThan3 + 1 468 Exit Function 469 End If 470 471 If (ignoreOld) Then 472 If (CompareFileTime(aFileTime, minDate) < 0) Then 473 IsTooOld = True 474 End If 475 End If 476 477 If (CompareFileTime(aWFD.ftLastWriteTime, m12Months) < 0) Then 478 mMoreThan12 = mMoreThan12 + 1 479 ElseIf (CompareFileTime(aWFD.ftLastWriteTime, m6Months) < 0) Then 480 mLessThan12 = mLessThan12 + 1 481 ElseIf (CompareFileTime(aWFD.ftLastWriteTime, m3Months) < 0) Then 482 mLessThan6 = mLessThan6 + 1 483 Else 484 mLessThan3 = mLessThan3 + 1 485 End If 486 487End Function 488 489Private Function BasicDateToFileTime(basDate As Date, _ 490 fileDate As FILETIME) As Boolean 491 492 Dim sysDate As SYSTEMTIME 493 Dim retval As Long 494 495 sysDate.wYear = DatePart("yyyy", basDate) 496 sysDate.wMonth = DatePart("m", basDate) 497 sysDate.wDay = DatePart("d", basDate) 498 sysDate.wHour = DatePart("h", basDate) 499 sysDate.wMinute = DatePart("m", basDate) 500 retval = SystemTimeToFileTime(sysDate, fileDate) 501 If (retval = 0) Then 502 BasicDateToFileTime = False 503 Else 504 BasicDateToFileTime = True 505 End If 506End Function 507 508Private Function InitFileTimes() As Boolean 509 510 Dim nowDate As Date 511 Dim basDate As Date 512 513 InitFileTimes = True 514 515 nowDate = Now() 516 basDate = DateAdd("m", -3, nowDate) 517 If Not BasicDateToFileTime(basDate, m3Months) Then InitFileTimes = False 518 519 basDate = DateAdd("m", -6, nowDate) 520 If Not BasicDateToFileTime(basDate, m6Months) Then InitFileTimes = False 521 522 basDate = DateAdd("yyyy", -1, nowDate) 523 If Not BasicDateToFileTime(basDate, m12Months) Then InitFileTimes = False 524 525 mMoreThan12 = 0 526 mLessThan12 = 0 527 mLessThan6 = 0 528 mLessThan3 = 0 529 530End Function 531