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