Attribute VB_Name = "RunServer" | |
'************************************************************************* | |
' | |
' Licensed to the Apache Software Foundation (ASF) under one | |
' or more contributor license agreements. See the NOTICE file | |
' distributed with this work for additional information | |
' regarding copyright ownership. The ASF licenses this file | |
' to you under the Apache License, Version 2.0 (the | |
' "License"); you may not use this file except in compliance | |
' with the License. You may obtain a copy of the License at | |
' | |
' http://www.apache.org/licenses/LICENSE-2.0 | |
' | |
' Unless required by applicable law or agreed to in writing, | |
' software distributed under the License is distributed on an | |
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY | |
' KIND, either express or implied. See the License for the | |
' specific language governing permissions and limitations | |
' under the License. | |
' | |
'************************************************************************* | |
Option Explicit | |
Private Declare Function WritePrivateProfileString Lib "kernel32" _ | |
Alias "WritePrivateProfileStringA" _ | |
(ByVal lpSectionName As String, _ | |
ByVal lpKeyName As Any, _ | |
ByVal lpString As Any, _ | |
ByVal lpFileName As String) As Long | |
Const CWORD_DRIVER = "_OOoDocAnalysisWordDriver.doc" | |
Const CEXCEL_DRIVER = "_OOoDocAnalysisExcelDriver.xls" | |
Const CPP_DRIVER = "_OOoDocAnalysisPPTDriver.ppt" | |
Const CWORD_APP = "word" | |
Const CEXCEL_APP = "excel" | |
Const CPP_APP = "pp" | |
Const CSTART_FILE = "PAW_Start_Analysis" | |
Const CSTOP_FILE = "PAW_Stop_Analysis" | |
Sub Main() | |
Dim serverType As String | |
serverType = LCase(Command$) | |
If (serverType <> CWORD_APP) And (serverType <> CEXCEL_APP) And (serverType <> CPP_APP) Then | |
MsgBox "Unknown server type: " & serverType | |
GoTo FinalExit | |
End If | |
Dim fso As New FileSystemObject | |
Dim driverName As String | |
If (serverType = CWORD_APP) Then | |
driverName = fso.GetAbsolutePathName(".\" & CWORD_DRIVER) | |
ElseIf (serverType = CEXCEL_APP) Then | |
driverName = fso.GetAbsolutePathName(".\" & CEXCEL_DRIVER) | |
ElseIf (serverType = CPP_APP) Then | |
driverName = fso.GetAbsolutePathName(".\" & CPP_DRIVER) | |
End If | |
If Not fso.FileExists(driverName) Then | |
If (serverType = CWORD_APP) Then | |
driverName = fso.GetAbsolutePathName(".\Resources\" & CWORD_DRIVER) | |
ElseIf (serverType = CEXCEL_APP) Then | |
driverName = fso.GetAbsolutePathName(".\Resources\" & CEXCEL_DRIVER) | |
ElseIf (serverType = CPP_APP) Then | |
driverName = fso.GetAbsolutePathName(".\Resources\" & CPP_DRIVER) | |
End If | |
End If | |
If Not fso.FileExists(driverName) Then | |
WriteToLog fso, "ALL", "LaunchDrivers: Could not find: " & driverName | |
GoTo FinalExit | |
End If | |
If (serverType = CWORD_APP) Then | |
OpenWordDriverDoc fso, driverName | |
ElseIf (serverType = CEXCEL_APP) Then | |
OpenExcelDriverDoc fso, driverName | |
ElseIf (serverType = CPP_APP) Then | |
OpenPPDriverDoc fso, driverName | |
End If | |
FinalExit: | |
Set fso = Nothing | |
End Sub | |
Sub OpenWordDriverDoc(fso As FileSystemObject, driverName As String) | |
Dim wrdApp As Word.Application | |
Dim wrdDriverDoc As Word.Document | |
On Error GoTo HandleErrors | |
Set wrdApp = New Word.Application | |
Set wrdDriverDoc = wrdApp.Documents.Open(driverName) | |
wrdApp.Run ("AnalysisTool.AnalysisDriver.AnalyseDirectory") | |
If Err.Number <> 0 Then | |
WriteToLog fso, CWORD_APP, "OpenWordDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source | |
End If | |
wrdDriverDoc.Close wdDoNotSaveChanges | |
wrdApp.Quit False | |
FinalExit: | |
Set wrdDriverDoc = Nothing | |
Set wrdApp = Nothing | |
Exit Sub | |
HandleErrors: | |
WriteToLog fso, CWORD_APP, "OpenWordDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source | |
Resume FinalExit | |
End Sub | |
Sub OpenExcelDriverDoc(fso As FileSystemObject, driverName As String) | |
Dim excelApp As Excel.Application | |
Dim excelDriverDoc As Excel.Workbook | |
On Error GoTo HandleErrors | |
Set excelApp = New Excel.Application | |
Set excelDriverDoc = Excel.Workbooks.Open(driverName) | |
excelApp.Run ("AnalysisTool.AnalysisDriver.AnalyseDirectory") | |
If Err.Number <> 0 Then | |
WriteToLog fso, CEXCEL_APP, "OpenExcelDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source | |
End If | |
excelDriverDoc.Close False | |
excelApp.Quit | |
FinalExit: | |
Set excelDriverDoc = Nothing | |
Set excelApp = Nothing | |
Exit Sub | |
HandleErrors: | |
WriteToLog fso, CEXCEL_APP, "OpenExcelDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source | |
Resume FinalExit | |
End Sub | |
Sub OpenPPDriverDoc(fso As FileSystemObject, driverName As String) | |
Dim ppApp As PowerPoint.Application | |
Dim ppDriverDoc As PowerPoint.Presentation | |
Dim ppDummy(0) As Variant | |
On Error GoTo HandleErrors | |
Set ppApp = New PowerPoint.Application | |
ppApp.Visible = msoTrue | |
Set ppDriverDoc = ppApp.Presentations.Open(driverName) ', msoTrue, msoFalse, msoFalse) | |
ppApp.Run ("AnalysisDriver.AnalyseDirectory") | |
If Err.Number <> 0 Then | |
WriteToLog fso, CPP_APP, "OpenPPDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source | |
End If | |
ppDriverDoc.Close | |
ppApp.Quit | |
FinalExit: | |
Set ppDriverDoc = Nothing | |
Set ppApp = Nothing | |
Exit Sub | |
HandleErrors: | |
WriteToLog fso, CPP_APP, "OpenPPDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source | |
Resume FinalExit | |
End Sub | |
Sub WriteToLog(fso As FileSystemObject, currApp As String, errMsg As String) | |
On Error Resume Next | |
Static ErrCount As Long | |
Dim logFileName As String | |
Dim tempPath As String | |
tempPath = fso.GetSpecialFolder(TemporaryFolder).Path | |
If (tempPath = "") Then tempPath = "." | |
logFileName = fso.GetAbsolutePathName(tempPath & "\LauchDrivers.log") | |
ErrCount = ErrCount + 1 | |
Call WritePrivateProfileString("ERRORS", currApp & "_log" & ErrCount, _ | |
errMsg, logFileName) | |
End Sub | |