1Attribute VB_Name = "RunServer" 2'************************************************************************* 3' 4' Licensed to the Apache Software Foundation (ASF) under one 5' or more contributor license agreements. See the NOTICE file 6' distributed with this work for additional information 7' regarding copyright ownership. The ASF licenses this file 8' to you under the Apache License, Version 2.0 (the 9' "License"); you may not use this file except in compliance 10' with the License. You may obtain a copy of the License at 11' 12' http://www.apache.org/licenses/LICENSE-2.0 13' 14' Unless required by applicable law or agreed to in writing, 15' software distributed under the License is distributed on an 16' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 17' KIND, either express or implied. See the License for the 18' specific language governing permissions and limitations 19' under the License. 20' 21'************************************************************************* 22Option Explicit 23 24Private Declare Function WritePrivateProfileString Lib "kernel32" _ 25 Alias "WritePrivateProfileStringA" _ 26 (ByVal lpSectionName As String, _ 27 ByVal lpKeyName As Any, _ 28 ByVal lpString As Any, _ 29 ByVal lpFileName As String) As Long 30 31Const CWORD_DRIVER = "_OOoDocAnalysisWordDriver.doc" 32Const CEXCEL_DRIVER = "_OOoDocAnalysisExcelDriver.xls" 33Const CPP_DRIVER = "_OOoDocAnalysisPPTDriver.ppt" 34 35Const CWORD_APP = "word" 36Const CEXCEL_APP = "excel" 37Const CPP_APP = "pp" 38 39Const CSTART_FILE = "PAW_Start_Analysis" 40Const CSTOP_FILE = "PAW_Stop_Analysis" 41 42Sub Main() 43 44 Dim serverType As String 45 serverType = LCase(Command$) 46 If (serverType <> CWORD_APP) And (serverType <> CEXCEL_APP) And (serverType <> CPP_APP) Then 47 MsgBox "Unknown server type: " & serverType 48 GoTo FinalExit 49 End If 50 51 Dim fso As New FileSystemObject 52 Dim driverName As String 53 54 If (serverType = CWORD_APP) Then 55 driverName = fso.GetAbsolutePathName(".\" & CWORD_DRIVER) 56 ElseIf (serverType = CEXCEL_APP) Then 57 driverName = fso.GetAbsolutePathName(".\" & CEXCEL_DRIVER) 58 ElseIf (serverType = CPP_APP) Then 59 driverName = fso.GetAbsolutePathName(".\" & CPP_DRIVER) 60 End If 61 62 If Not fso.FileExists(driverName) Then 63 If (serverType = CWORD_APP) Then 64 driverName = fso.GetAbsolutePathName(".\Resources\" & CWORD_DRIVER) 65 ElseIf (serverType = CEXCEL_APP) Then 66 driverName = fso.GetAbsolutePathName(".\Resources\" & CEXCEL_DRIVER) 67 ElseIf (serverType = CPP_APP) Then 68 driverName = fso.GetAbsolutePathName(".\Resources\" & CPP_DRIVER) 69 End If 70 End If 71 72 If Not fso.FileExists(driverName) Then 73 WriteToLog fso, "ALL", "LaunchDrivers: Could not find: " & driverName 74 GoTo FinalExit 75 End If 76 77 If (serverType = CWORD_APP) Then 78 OpenWordDriverDoc fso, driverName 79 ElseIf (serverType = CEXCEL_APP) Then 80 OpenExcelDriverDoc fso, driverName 81 ElseIf (serverType = CPP_APP) Then 82 OpenPPDriverDoc fso, driverName 83 End If 84 85FinalExit: 86 87 Set fso = Nothing 88End Sub 89 90Sub OpenWordDriverDoc(fso As FileSystemObject, driverName As String) 91 92 Dim wrdApp As Word.Application 93 Dim wrdDriverDoc As Word.Document 94 95 On Error GoTo HandleErrors 96 97 Set wrdApp = New Word.Application 98 Set wrdDriverDoc = wrdApp.Documents.Open(driverName) 99 100 wrdApp.Run ("AnalysisTool.AnalysisDriver.AnalyseDirectory") 101 If Err.Number <> 0 Then 102 WriteToLog fso, CWORD_APP, "OpenWordDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source 103 End If 104 105 wrdDriverDoc.Close wdDoNotSaveChanges 106 wrdApp.Quit False 107 108FinalExit: 109 Set wrdDriverDoc = Nothing 110 Set wrdApp = Nothing 111 Exit Sub 112 113HandleErrors: 114 WriteToLog fso, CWORD_APP, "OpenWordDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source 115 Resume FinalExit 116End Sub 117 118Sub OpenExcelDriverDoc(fso As FileSystemObject, driverName As String) 119 120 Dim excelApp As Excel.Application 121 Dim excelDriverDoc As Excel.Workbook 122 123 On Error GoTo HandleErrors 124 125 Set excelApp = New Excel.Application 126 Set excelDriverDoc = Excel.Workbooks.Open(driverName) 127 excelApp.Run ("AnalysisTool.AnalysisDriver.AnalyseDirectory") 128 129 If Err.Number <> 0 Then 130 WriteToLog fso, CEXCEL_APP, "OpenExcelDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source 131 End If 132 133 excelDriverDoc.Close False 134 excelApp.Quit 135 136FinalExit: 137 Set excelDriverDoc = Nothing 138 Set excelApp = Nothing 139 Exit Sub 140 141HandleErrors: 142 WriteToLog fso, CEXCEL_APP, "OpenExcelDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source 143 Resume FinalExit 144End Sub 145 146Sub OpenPPDriverDoc(fso As FileSystemObject, driverName As String) 147 148 Dim ppApp As PowerPoint.Application 149 Dim ppDriverDoc As PowerPoint.Presentation 150 Dim ppDummy(0) As Variant 151 152 On Error GoTo HandleErrors 153 154 Set ppApp = New PowerPoint.Application 155 ppApp.Visible = msoTrue 156 Set ppDriverDoc = ppApp.Presentations.Open(driverName) ', msoTrue, msoFalse, msoFalse) 157 ppApp.Run ("AnalysisDriver.AnalyseDirectory") 158 159 If Err.Number <> 0 Then 160 WriteToLog fso, CPP_APP, "OpenPPDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source 161 End If 162 163 ppDriverDoc.Close 164 ppApp.Quit 165 166FinalExit: 167 Set ppDriverDoc = Nothing 168 Set ppApp = Nothing 169 Exit Sub 170 171HandleErrors: 172 WriteToLog fso, CPP_APP, "OpenPPDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source 173 Resume FinalExit 174End Sub 175 176Sub WriteToLog(fso As FileSystemObject, currApp As String, errMsg As String) 177 178 On Error Resume Next 179 180 Static ErrCount As Long 181 Dim logFileName As String 182 Dim tempPath As String 183 184 tempPath = fso.GetSpecialFolder(TemporaryFolder).Path 185 If (tempPath = "") Then tempPath = "." 186 logFileName = fso.GetAbsolutePathName(tempPath & "\LauchDrivers.log") 187 ErrCount = ErrCount + 1 188 189 Call WritePrivateProfileString("ERRORS", currApp & "_log" & ErrCount, _ 190 errMsg, logFileName) 191End Sub 192 193