1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
Attribute VB_Name = "RunServer"
'/*************************************************************************
' *
' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
'
' Copyright 2000, 2010 Oracle and/or its affiliates.
'
' OpenOffice.org - a multi-platform office productivity suite
'
' This file is part of OpenOffice.org.
'
' OpenOffice.org is free software: you can redistribute it and/or modify
' it under the terms of the GNU Lesser General Public License version 3
' only, as published by the Free Software Foundation.
'
' OpenOffice.org is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU Lesser General Public License version 3 for more details
' (a copy is included in the LICENSE file that accompanied this code).
'
' You should have received a copy of the GNU Lesser General Public License
' version 3 along with OpenOffice.org. If not, see
' <http://www.openoffice.org/license.html>
' for a copy of the LGPLv3 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
|
