migrationanalysis/src/wizard/CollectedFiles.cls

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