migrationanalysis/src/wizard/Analyse.bas

   1 Attribute VB_Name = "Analyse"
   2 '/*************************************************************************
   3 ' *
   4 ' * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   5 ' *
   6 ' * Copyright 2008 by Sun Microsystems, Inc.
   7 ' *
   8 ' * OpenOffice.org - a multi-platform office productivity suite
   9 ' *
  10 ' * $RCSfile: Analyse.bas,v $
  11 ' * $Revision: 1.2.66.1 $
  12 ' *
  13 ' * This file is part of OpenOffice.org.
  14 ' *
  15 ' * OpenOffice.org is free software: you can redistribute it and/or modify
  16 ' * it under the terms of the GNU Lesser General Public License version 3
  17 ' * only, as published by the Free Software Foundation.
  18 ' *
  19 ' * OpenOffice.org is distributed in the hope that it will be useful,
  20 ' * but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ' * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ' * GNU Lesser General Public License version 3 for more details
  23 ' * (a copy is included in the LICENSE file that accompanied this code).
  24 ' *
  25 ' * You should have received a copy of the GNU Lesser General Public License
  26 ' * version 3 along with OpenOffice.org.  If not, see
  27 ' * <http://www.openoffice.org/license.html>
  28 ' * for a copy of the LGPLv3 License.
  29 ' *
  30 ' ************************************************************************/
  31
  32 Option Explicit
  33
  34 Private Const C_STAT_NOT_STARTED    As Integer = 1
  35 Private Const C_STAT_RETRY          As Integer = 2
  36 Private Const C_STAT_ERROR          As Integer = 3
  37 Private Const C_STAT_DONE           As Integer = 4
  38 Private Const C_STAT_ABORTED        As Integer = 5
  39
  40 Private Const C_MAX_RETRIES         As Integer = 5
  41 Private Const C_ABORT_TIMEOUT       As Integer = 30
  42
  43 Private Const MAX_WAIT_TIME     As Long = 600
  44
  45 Private Const C_STAT_FINISHED   As String = "finished"
  46 Private Const C_STAT_ANALYSED   As String = "analysed="
  47 Private Const C_STAT_ANALYSING  As String = "analysing="
  48 Private Const CSINGLE_FILE      As String = "singlefile"
  49 Private Const CFILE_LIST        As String = "filelist"
  50 Private Const CSTAT_FILE        As String = "statfilename"
  51 Private Const CLAST_CHECKPOINT  As String = "LastCheckpoint"
  52 Private Const CNEXT_FILE        As String = "NextFile"
  53 Private Const C_ABORT_ANALYSIS  As String = "AbortAnalysis"
  54
  55 Private Const CAPPNAME_WORD         As String = "word"
  56 Private Const CAPPNAME_EXCEL        As String = "excel"
  57 Private Const CAPPNAME_POWERPOINT   As String = "powerpoint"
  58 Private Const C_EXENAME_WORD        As String = "winword.exe"
  59 Private Const C_EXENAME_EXCEL       As String = "excel.exe"
  60 Private Const C_EXENAME_POWERPOINT  As String = "powerpnt.exe"
  61
  62 Const CNEW_RESULTS_FILE = "newresultsfile"
  63 Const C_LAUNCH_DRIVER = ".\resources\LaunchDrivers.exe"
  64
  65 'from http://support.microsoft.com/kb/q129796
  66
  67 Private Type STARTUPINFO
  68     cb As Long
  69     lpReserved As String
  70     lpDesktop As String
  71     lpTitle As String
  72     dwX As Long
  73     dwY As Long
  74     dwXSize As Long
  75     dwYSize As Long
  76     dwXCountChars As Long
  77     dwYCountChars As Long
  78     dwFillAttribute As Long
  79     dwFlags As Long
  80     wShowWindow As Integer
  81     cbReserved2 As Integer
  82     lpReserved2 As Long
  83     hStdInput As Long
  84     hStdOutput As Long
  85     hStdError As Long
  86 End Type
  87
  88 Private Type PROCESS_INFORMATION
  89     hProcess As Long
  90     hThread As Long
  91     dwProcessID As Long
  92     dwThreadID As Long
  93 End Type
  94
  95 Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
  96     hHandle As Long, ByVal dwMilliseconds As Long) As Long
  97
  98 Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
  99     lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
 100     lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
 101     ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
 102     ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
 103     lpStartupInfo As STARTUPINFO, lpProcessInformation As _
 104     PROCESS_INFORMATION) As Long
 105
 106 Private Declare Function CloseHandle Lib "kernel32" _
 107     (ByVal hObject As Long) As Long
 108
 109 Private Declare Function GetExitCodeProcess Lib "kernel32" _
 110     (ByVal hProcess As Long, lpExitCode As Long) As Long
 111
 112 Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, _
 113         ByVal uExitCode As Long) As Long
 114
 115 Private Const NORMAL_PRIORITY_CLASS = &H20&
 116 Private Const WAIT_TIMEOUT  As Long = &H102
 117 Private Const ABORTED       As Long = -2
 118
 119 ' from http://vbnet.mvps.org/index.html?code/system/toolhelpprocesses.htm
 120 Public Const TH32CS_SNAPPROCESS As Long = 2&
 121 Public Const MAX_PATH As Long = 260
 122
 123 Public Type PROCESSENTRY32
 124     dwSize As Long
 125     cntUsage As Long
 126     th32ProcessID As Long
 127     th32DefaultHeapID As Long
 128     th32ModuleID As Long
 129     cntThreads As Long
 130     th32ParentProcessID As Long
 131     pcPriClassBase As Long
 132     dwFlags As Long
 133     szExeFile As String * MAX_PATH
 134 End Type
 135
 136 Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" _
 137    (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
 138
 139 Public Declare Function ProcessFirst Lib "kernel32" _
 140     Alias "Process32First" _
 141    (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
 142
 143 Public Declare Function ProcessNext Lib "kernel32" _
 144     Alias "Process32Next" _
 145    (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
 146
 147
 148 Public Function IsOfficeAppRunning(curApplication As String) As Boolean
 149 'DV: we need some error handling here
 150     Dim hSnapShot As Long
 151     Dim uProcess As PROCESSENTRY32
 152     Dim success As Long
 153     Dim bRet As Boolean
 154     Dim bAppFound As Boolean
 155     Dim exeName As String
 156     Dim curExeName As String
 157
 158     bRet = True
 159     On Error GoTo FinalExit
 160
 161     curExeName = LCase$(curApplication)
 162
 163     If (curExeName = CAPPNAME_WORD) Then
 164         exeName = C_EXENAME_WORD
 165     ElseIf (curExeName = CAPPNAME_EXCEL) Then
 166         exeName = C_EXENAME_EXCEL
 167     ElseIf (curExeName = CAPPNAME_POWERPOINT) Then
 168         exeName = C_EXENAME_POWERPOINT
 169     Else
 170         GoTo FinalExit
 171     End If
 172
 173     hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
 174
 175     If hSnapShot = -1 Then GoTo FinalExit
 176
 177     uProcess.dwSize = Len(uProcess)
 178     success = ProcessFirst(hSnapShot, uProcess)
 179     bAppFound = False
 180
 181     While ((success = 1) And Not bAppFound)
 182         Dim i As Long
 183         i = InStr(1, uProcess.szExeFile, Chr(0))
 184         curExeName = LCase$(Left$(uProcess.szExeFile, i - 1))
 185         If (curExeName = exeName) Then
 186             bAppFound = True
 187         Else
 188             success = ProcessNext(hSnapShot, uProcess)
 189         End If
 190     Wend
 191     bRet = bAppFound
 192
 193     Call CloseHandle(hSnapShot)
 194
 195 FinalExit:
 196     IsOfficeAppRunning = bRet
 197
 198 End Function
 199
 200 Private Sub CalculateProgress(statusFileName As String, fso As FileSystemObject, _
 201                               lastIndex As Long, docOffset As Long, _
 202                               myDocList As Collection)
 203
 204     On Error GoTo FinalExit
 205
 206     Dim curFile As String
 207     Dim fileCont As TextStream
 208     Dim myFile As file
 209
 210     If (fso.FileExists(statusFileName)) Then
 211         Dim statLine As String
 212
 213         Set fileCont = fso.OpenTextFile(statusFileName, ForReading, False, TristateTrue)
 214         statLine = fileCont.ReadLine
 215
 216         If (Left(statLine, Len(C_STAT_ANALYSED)) = C_STAT_ANALYSED) Then
 217             curFile = Mid(statLine, Len(C_STAT_ANALYSED) + 1)
 218         ElseIf (Left(statLine, Len(C_STAT_ANALYSING)) = C_STAT_ANALYSING) Then
 219             curFile = Mid(statLine, Len(C_STAT_ANALYSING) + 1)
 220         End If
 221     End If
 222
 223     ' when we don't have a file, we will show the name of the last used file in
 224     ' the progress window
 225     If (curFile = "") Then curFile = myDocList.item(lastIndex)
 226
 227     If (GetDocumentIndex(curFile, myDocList, lastIndex)) Then
 228         Set myFile = fso.GetFile(curFile)
 229         Call ShowProgress.SP_UpdateProgress(myFile.Name, myFile.ParentFolder.path, lastIndex + docOffset)
 230     End If
 231
 232 FinalExit:
 233     If Not (fileCont Is Nothing) Then fileCont.Close
 234     Set fileCont = Nothing
 235     Set myFile = Nothing
 236
 237 End Sub
 238
 239 Function CheckAliveStatus(statFileName As String, _
 240                           curApplication As String, _
 241                           lastDate As Date, _
 242                           fso As FileSystemObject) As Boolean
 243
 244     Dim isAlive As Boolean
 245     Dim currDate As Date
 246     Dim statFile As file
 247     Dim testing As Long
 248
 249     isAlive = False
 250
 251     If Not fso.FileExists(statFileName) Then
 252         currDate = Now()
 253         If (val(DateDiff("s", lastDate, currDate)) > MAX_WAIT_TIME) Then
 254             isAlive = False
 255         Else
 256             isAlive = True
 257         End If
 258     Else
 259         Set statFile = fso.GetFile(statFileName)
 260         currDate = statFile.DateLastModified
 261         If (currDate > lastDate) Then
 262             lastDate = currDate
 263             isAlive = True
 264         Else
 265             currDate = Now()
 266             If (lastDate >= currDate) Then   ' There might be some inaccuracies in file and system dates
 267                 isAlive = True
 268             ElseIf (val(DateDiff("s", lastDate, currDate)) > MAX_WAIT_TIME) Then
 269                 isAlive = False
 270             Else
 271                 isAlive = IsOfficeAppRunning(curApplication)
 272             End If
 273         End If
 274     End If
 275
 276     CheckAliveStatus = isAlive
 277 End Function
 278
 279 Sub TerminateOfficeApps(fso As FileSystemObject, aParameter As String)
 280
 281     Dim msoKillFileName As String
 282
 283     msoKillFileName = fso.GetAbsolutePathName(".\resources\msokill.exe")
 284     If fso.FileExists(msoKillFileName) Then
 285         Shell msoKillFileName & aParameter
 286     Else
 287     End If
 288 End Sub
 289
 290 Public Function launchDriver(statFileName As String, cmdLine As String, _
 291                              curApplication As String, fso As FileSystemObject, _
 292                              myDocList As Collection, myOffset As Long, _
 293                              myIniFilePath As String) As Long
 294
 295     Dim proc As PROCESS_INFORMATION
 296     Dim start As STARTUPINFO
 297     Dim ret As Long
 298     Dim currDate As Date
 299     Dim lastIndex As Long
 300
 301     currDate = Now()
 302     lastIndex = 1
 303
 304     ' Initialize the STARTUPINFO structure:
 305     start.cb = Len(start)
 306
 307     ' Start the shelled application:
 308     ret = CreateProcessA(vbNullString, cmdLine$, 0&, 0&, 1&, _
 309                          NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
 310
 311     ' Wait for the shelled application to finish:
 312     Do
 313         ret = WaitForSingleObject(proc.hProcess, 100)
 314         If ret <> WAIT_TIMEOUT Then
 315             Exit Do
 316         End If
 317         If Not CheckAliveStatus(statFileName, curApplication, currDate, fso) Then
 318             ' Try to close open office dialogs and then wait a little bit
 319             TerminateOfficeApps fso, " --close"
 320             ret = WaitForSingleObject(proc.hProcess, 1000)
 321
 322             ' next try to kill all office programs and then wait a little bit
 323             TerminateOfficeApps fso, " --kill"
 324             ret = WaitForSingleObject(proc.hProcess, 1000)
 325
 326             ret = TerminateProcess(proc.hProcess, "0")
 327             ret = WAIT_TIMEOUT
 328             Exit Do
 329         End If
 330         If (ShowProgress.g_SP_Abort) Then
 331             WriteToLog C_ABORT_ANALYSIS, True, myIniFilePath
 332             Call HandleAbort(proc.hProcess, curApplication)
 333             ret = ABORTED
 334             Exit Do
 335         End If
 336         Call CalculateProgress(statFileName, fso, lastIndex, myOffset, myDocList)
 337         DoEvents                                'allow other processes
 338     Loop While True
 339
 340     If (ret <> WAIT_TIMEOUT) And (ret <> ABORTED) Then
 341         Call GetExitCodeProcess(proc.hProcess, ret&)
 342     End If
 343     Call CloseHandle(proc.hThread)
 344     Call CloseHandle(proc.hProcess)
 345     launchDriver = ret
 346 End Function
 347
 348 Function CheckAnalyseStatus(statusFileName As String, _
 349                             lastFile As String, _
 350                             fso As FileSystemObject) As Integer
 351
 352     Dim currStatus As Integer
 353     Dim fileCont As TextStream
 354
 355     If Not fso.FileExists(statusFileName) Then
 356         currStatus = C_STAT_NOT_STARTED
 357     Else
 358         Dim statText As String
 359         Set fileCont = fso.OpenTextFile(statusFileName, ForReading, False, TristateTrue)
 360         statText = fileCont.ReadLine
 361         If (statText = C_STAT_FINISHED) Then
 362             currStatus = C_STAT_DONE
 363         ElseIf (Left(statText, Len(C_STAT_ANALYSED)) = C_STAT_ANALYSED) Then
 364             currStatus = C_STAT_RETRY
 365             lastFile = Mid(statText, Len(C_STAT_ANALYSED) + 1)
 366         ElseIf (Left(statText, Len(C_STAT_ANALYSING)) = C_STAT_ANALYSING) Then
 367             currStatus = C_STAT_RETRY
 368             lastFile = Mid(statText, Len(C_STAT_ANALYSING) + 1)
 369         Else
 370             currStatus = C_STAT_ERROR
 371         End If
 372         fileCont.Close
 373     End If
 374
 375     CheckAnalyseStatus = currStatus
 376 End Function
 377
 378 Function WriteDocsToAnalyze(myDocList As Collection, myApp As String, _
 379                             fso As FileSystemObject) As String
 380     On Error GoTo HandleErrors
 381     Dim currentFunctionName As String
 382     currentFunctionName = "WriteDocsToAnalyze"
 383
 384     Dim TempPath As String
 385     Dim fileName As String
 386     Dim fileContent As TextStream
 387
 388     fileName = ""
 389     TempPath = fso.GetSpecialFolder(TemporaryFolder).path
 390
 391     If (TempPath = "") Then
 392         TempPath = "."
 393     End If
 394
 395     Dim vFileName As Variant
 396     Dim Index As Long
 397     Dim limit As Long
 398
 399     limit = myDocList.count
 400     If (limit > 0) Then
 401         fileName = fso.GetAbsolutePathName(TempPath & "\FileList" & myApp & ".txt")
 402         Set fileContent = fso.OpenTextFile(fileName, ForWriting, True, TristateTrue)
 403
 404         For Index = 1 To limit
 405             vFileName = myDocList(Index)
 406             fileContent.WriteLine (vFileName)
 407         Next
 408
 409         fileContent.Close
 410     End If
 411
 412 FinalExit:
 413     Set fileContent = Nothing
 414     WriteDocsToAnalyze = fileName
 415     Exit Function
 416
 417 HandleErrors:
 418     WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
 419     Resume FinalExit
 420 End Function
 421
 422 ' This function looks for the given document name in the document collection
 423 ' and returns TRUE and the position of the document in that collection if found,
 424 ' FALSE otherwise
 425 Function GetDocumentIndex(myDocument As String, _
 426                           myDocList As Collection, _
 427                           lastIndex As Long) As Boolean
 428
 429     Dim currentFunctionName As String
 430     currentFunctionName = "GetDocumentIndex"
 431
 432     On Error GoTo HandleErrors
 433
 434     Dim lastEntry As Long
 435     Dim curIndex As Long
 436     Dim curEntry As String
 437     Dim entryFound As Boolean
 438
 439     entryFound = False
 440     lastEntry = myDocList.count
 441     curIndex = lastIndex
 442
 443     ' We start the search at the position of the last found
 444     ' document
 445     While Not entryFound And curIndex <= lastEntry
 446         curEntry = myDocList.item(curIndex)
 447         If (curEntry = myDocument) Then
 448             lastIndex = curIndex
 449             entryFound = True
 450         Else
 451             curIndex = curIndex + 1
 452         End If
 453     Wend
 454
 455     ' When we could not find the document, we start the search
 456     ' from the beginning of the list
 457     If Not entryFound Then
 458         curIndex = 1
 459         While Not entryFound And curIndex <= lastIndex
 460             curEntry = myDocList.item(curIndex)
 461             If (curEntry = myDocument) Then
 462                 lastIndex = curIndex
 463                 entryFound = True
 464             Else
 465                 curIndex = curIndex + 1
 466             End If
 467         Wend
 468     End If
 469
 470 FinalExit:
 471     GetDocumentIndex = entryFound
 472     Exit Function
 473 HandleErrors:
 474     WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
 475     Resume FinalExit
 476 End Function
 477
 478 Function AnalyseList(myDocList As Collection, _
 479                      myApp As String, _
 480                      myIniFilePath As String, _
 481                      myOffset As Long, _
 482                      analysisAborted As Boolean) As Boolean
 483
 484     On Error GoTo HandleErrors
 485     Dim currentFunctionName As String
 486     currentFunctionName = "AnalyseList"
 487
 488     Dim cmdLine As String
 489     Dim filelist As String
 490     Dim statFileName As String
 491     Dim finished As Boolean
 492     Dim analyseStatus As Integer
 493     Dim nRetries As Integer
 494     Dim lastFile As String
 495     Dim lastHandledFile As String
 496     Dim launchStatus As Long
 497     Dim fso As New FileSystemObject
 498     Dim progressTitle As String
 499
 500     filelist = WriteDocsToAnalyze(myDocList, myApp, fso)
 501     cmdLine = fso.GetAbsolutePathName(C_LAUNCH_DRIVER) & " " & myApp
 502     finished = False
 503
 504     Dim TempPath As String
 505     TempPath = fso.GetSpecialFolder(TemporaryFolder).path
 506     If (TempPath = "") Then TempPath = "."
 507     statFileName = fso.GetAbsolutePathName(TempPath & "\StatFile" & myApp & ".txt")
 508     If (fso.FileExists(statFileName)) Then fso.DeleteFile (statFileName)
 509
 510     WriteToLog CFILE_LIST, filelist, myIniFilePath
 511     WriteToLog CSTAT_FILE, statFileName, myIniFilePath
 512     WriteToLog CLAST_CHECKPOINT, "", myIniFilePath
 513     WriteToLog CNEXT_FILE, "", myIniFilePath
 514     WriteToLog C_ABORT_ANALYSIS, "", myIniFilePath
 515
 516     ' In this loop we will restart the driver until we have finished the analysis
 517     nRetries = 0
 518     While Not finished And nRetries < C_MAX_RETRIES
 519         launchStatus = launchDriver(statFileName, cmdLine, myApp, fso, _
 520                                     myDocList, myOffset, myIniFilePath)
 521         If (launchStatus = ABORTED) Then
 522             finished = True
 523             analyseStatus = C_STAT_ABORTED
 524             analysisAborted = True
 525         Else
 526             analyseStatus = CheckAnalyseStatus(statFileName, lastHandledFile, fso)
 527         End If
 528         If (analyseStatus = C_STAT_DONE) Then
 529             finished = True
 530         ElseIf (analyseStatus = C_STAT_RETRY) Then
 531             If (lastHandledFile = lastFile) Then
 532                 nRetries = nRetries + 1
 533             Else
 534                 lastFile = lastHandledFile
 535                 nRetries = 1
 536             End If
 537         Else
 538             nRetries = nRetries + 1
 539         End If
 540     Wend
 541
 542     If (analyseStatus = C_STAT_DONE) Then
 543         AnalyseList = True
 544     Else
 545         AnalyseList = False
 546     End If
 547
 548     'The next driver should not overwrite this result file
 549     WriteToLog CNEW_RESULTS_FILE, "False", myIniFilePath
 550
 551 FinalExit:
 552     Set fso = Nothing
 553     Exit Function
 554
 555 HandleErrors:
 556     AnalyseList = False
 557     WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
 558     Resume FinalExit
 559 End Function
 560
 561 Sub HandleAbort(hProcess As Long, curApplication As String)
 562
 563     On Error Resume Next
 564
 565     Dim ret As Long
 566     Dim curDate As Date
 567     Dim stillWaiting As Boolean
 568     Dim killApplication As Boolean
 569     Dim waitTime As Long
 570
 571     curDate = Now()
 572     stillWaiting = True
 573     killApplication = False
 574
 575     While stillWaiting
 576         stillWaiting = IsOfficeAppRunning(curApplication)
 577         If (stillWaiting) Then
 578             waitTime = val(DateDiff("s", curDate, Now()))
 579             If (waitTime > C_ABORT_TIMEOUT) Then
 580                 stillWaiting = False
 581                 killApplication = True
 582             End If
 583         End If
 584     Wend
 585
 586     If (killApplication) Then
 587         ShowProgress.g_SP_AllowOtherDLG = True
 588         TerminateMSO.Show vbModal, ShowProgress
 589     End If
 590
 591     ret = TerminateProcess(hProcess, "0")
 592 End Sub