-
Notifications
You must be signed in to change notification settings - Fork 1
/
Logger.vb
326 lines (298 loc) · 21.5 KB
/
Logger.vb
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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
Imports ExcelDna.Integration
Imports Microsoft.Office.Interop
Imports System.Diagnostics ' needed for EventLogEntryType and Trace !!
Imports System.IO
Imports System.Runtime.InteropServices
''' <summary>main class to be used in clients: set theLogger = createObject("LogAddin.Logger")
''' doing logging with LogError, LogWarn, LogInfo, LogDebug and LogFatal
''' Logger properties are set with setProperties.
''' </summary>
<ComVisible(True)>
<ClassInterface(ClassInterfaceType.AutoDispatch)>
<ProgId("LogAddin.Logger")>
Public Class Logger
Private CallerInfo As String
Private callingObject As Object
Private callingObjectPath As String
Private LogLevel As EventLogEntryType
Private LogFilePath As String
Private env As String
Private commonCaller As String
Private Caller As String
Private callerFullPath As String
Private mailRecipients As String
Private Subject As String
Private doEventLog As Boolean
Private Sender As String
Private MailIntro As String
Private MailGreetings As String
Private mirrorToStdOut As Boolean
Private AlreadySent As Boolean
Private cdoUserID As String
Private cdoPassword As String
Private cdoUseSSL As Boolean
Private cdoConnectiontimeout As Integer
Private cdoAuthentRequired As Boolean 'false
Private cdoServerName As String '= "SomeSMTPServer" 'Name or IP of Remote SMTP Server
Private cdoServerPort As Integer '= 25 'Server port (typically 25)
Private cdoInternalErrMailRcpt As String '
Private defaultSubject As String '"Batch Process Error"
Private defaultSender As String '"Administrator"
Private defaultMailIntro As String '"Folgender Fehler trat in batch process auf "
Private defaultMailGreetings As String '"liebe Grüße schickt der Fehleradmin..."
Private timeStampCulture As String '""
Private timeStampFormat As String '"dd.MM.yyyy HH:mm:ss"
Private logentry() As String
''' <summary></summary>
Public Sub New()
cdoUserID = fetchSetting("cdoUserID", "")
cdoPassword = fetchSetting("cdoPassword", "")
cdoUseSSL = CBool(fetchSetting("cdoUseSSL", False))
cdoConnectiontimeout = CInt(fetchSetting("cdoConnectiontimeout", 0))
cdoAuthentRequired = CBool(fetchSetting("cdoAuthentRequired", False))
cdoServerName = fetchSetting("cdoServerName", "YOURSMTPSERVERNAME") 'Name or IP of Remote SMTP Server
cdoServerPort = CInt(fetchSetting("cdoServerPort", 25)) 'Server port (typically 25)
cdoInternalErrMailRcpt = fetchSetting("cdoInternalErrMailRcpt", "internalErrAdmin1,internalErrAdmin2")
defaultSubject = fetchSetting("defaultSubject", "Batch Process Error")
defaultSender = fetchSetting("defaultSender", "Administrator")
defaultMailIntro = fetchSetting("defaultMailIntro", "Folgender Fehler trat in batch process auf ")
defaultMailGreetings = fetchSetting("defaultMailGreetings", "liebe Grüße schickt der Fehleradmin...")
timeStampFormat = fetchSetting("timeStampFormat", "dd.MM.yyyy HH:mm:ss")
timeStampCulture = fetchSetting("timeStampCulture", "")
Dim i As Integer
i = 0
Dim entry As String = fetchSetting("logentry" & i, vbNullString)
While Len(entry) > 0
ReDim Preserve logentry(i)
logentry(i) = entry
i += 1
entry = fetchSetting("logentry" & i, vbNullString)
End While
If i = 0 Then MsgBox("No logentry defined in registry settings !")
mirrorToStdOut = False
End Sub
''' <summary>sets properties for the Logger object, all parameters optional except theCallingObject</summary>
''' <param name="theCallingObject">the calling object (excel workbook)</param>
''' <param name="theLogLevel">log level (ERROR 1, WARN 2, INFO 4, DEBUG 8), default = 4</param>
''' <param name="theLogFilePath">where to write the logfile (LogFilePath), defaults to callingObject's path</param>
''' <param name="theEnv">environment, empty if production, used to append env to LogFilePath for test/other environments</param>
''' <param name="theCaller">if caller is not the callingObject (commonCaller) then this can be used to identify the active caller (in case of an addin handling multiple workbooks/documents/..).
''' Can include the full path to the calling workbook/document/.., the Caller's name will be extracted by using last "\" as separator</param>
''' <param name="theMailRecipients">comma separated list of the error mail recipients</param>
''' <param name="theSubject">the error mail's subject</param>
''' <param name="writeToEventLog">should messages be written to the windows event log (true) or to a file (false)</param>
''' <param name="theSender">the Sender of the sent error mails</param>
''' <param name="theMailIntro">the intro for the error mail's body</param>
''' <param name="theMailGreetings">the greetings for the error mail's body, body looks as follows:
''' [MailIntro] (executed in: [commonCaller], current caller: [Caller]):
''' [logLine]
''' [logPathMsg]
''' [MailGreetings]</param>
''' <param name="overrideCommonCaller">whether to override CallingObjectName (filename to log to) with theCaller</param>
''' <param name="doMirrorToStdOut">Boolean used for mirroring logging to a trace dialog</param>
Public Sub setProperties(Optional theCallingObject As Excel.Workbook = Nothing, Optional theLogLevel As Integer = 4, Optional theLogFilePath As String = Nothing,
Optional theEnv As String = Nothing, Optional theCaller As String = Nothing, Optional theMailRecipients As String = Nothing,
Optional theSubject As String = Nothing, Optional writeToEventLog As Boolean = False, Optional theSender As String = Nothing, Optional theMailIntro As String = Nothing,
Optional theMailGreetings As String = Nothing, Optional overrideCommonCaller As Boolean = False, Optional doMirrorToStdOut As Boolean = False)
AlreadySent = False
If theCallingObject Is Nothing Then
Dim sModuleInfo As String = vbNullString
' get module info for buildtime (FileDateTime of xll):
For Each tModule As ProcessModule In Process.GetCurrentProcess().Modules
Dim sModule As String = tModule.FileName
If sModule.ToUpper.Contains("CMDLOGADDIN") Then
sModuleInfo = FileDateTime(sModule).ToString()
End If
Next
MsgBox("Logger.setProperties sets properties for the Logger object" & vbCrLf & vbCrLf &
"- theCallingObject .. the calling excel workbook," & vbCrLf & vbCrLf &
"These arguments are optional (default=empty/false if not specified):" & vbCrLf &
"- theLogLevel .. (ERROR 1, WARN 2, INFO 4, DEBUG 8), default = 4" & vbCrLf &
"- theLogFilePath .. where to write the logfile (LogFilePath), defaults to callingObject's path" & vbCrLf &
"- theEnv .. environment, empty if production, used to append env to LogFilePath for test/other environments" & vbCrLf &
"- theCaller .. if caller is not the callingObject (commonCaller) then this can be used to" & vbCrLf &
" * identify the active caller (in case of an addin handling multiple workbooks..)." & vbCrLf &
" * Can include the full path to the calling workbook..," & vbCrLf &
" * the Caller's name will be extracted by using last \ as separator" & vbCrLf &
"- theMailRecipients .. comma separated list of the error mail recipients" & vbCrLf &
"- theSubject .. the error mail's subject" & vbCrLf &
"- writeToEventLog .. should messages be written to the windows event log (true) or to a file (false)" & vbCrLf &
"- theSender .. the Sender of the sent error mails" & vbCrLf &
"- theMailIntro .. the intro for the error mail's body" & vbCrLf &
"- theMailGreetings .. the greetings for the error mail's body, body looks as follows:" & vbCrLf &
" <MailIntro> (executed in: <commonCaller>, current caller: <Caller>):" & vbCrLf &
" <logLine>" & vbCrLf &
" <logPathMsg>" & vbCrLf &
" <MailGreetings>" & vbCrLf &
"- overrideCommonCaller .. override CallingObjectName (filename to log to) with given parameter theCaller (true)" & vbCrLf &
"- doMirrorToStdOut .. Boolean used for mirroring logging to a trace dialog",
MsgBoxStyle.Information + MsgBoxStyle.OkOnly, String.Format("CmdLogAddin Version {0} Buildtime {1}", My.Application.Info.Version.ToString, sModuleInfo))
MsgBox("Logging is then done with following five methods:" & vbCrLf &
"- Logger.LogDebug(msg) .. writes msg if debug level (theLogLevel in setProperties) = 8" & vbCrLf &
"- Logger.LogInfo(msg) .. writes msg if debug level >= 4" & vbCrLf &
"- Logger.LogWarn(msg) .. writes msg if debug level >= 2" & vbCrLf &
"- Logger.LogError(msg) .. writes msg if debug level >= 1, additionally an error mail is sent to theMailRecipients" & vbCrLf &
"- Logger.LogFatal(msg) .. writes msg if debug level >= 1, additionally to the error mail the host application is shut down" & vbCrLf & vbCrLf &
"Author/Website: " & My.Application.Info.CompanyName.ToString & vbCrLf &
"License: " & My.Application.Info.Copyright.ToString,
MsgBoxStyle.Information + MsgBoxStyle.OkOnly, String.Format("CmdLogAddin Version {0} Buildtime {1}", My.Application.Info.Version.ToString, sModuleInfo))
Exit Sub
End If
On Error Resume Next
1: callingObject = theCallingObject
2: commonCaller = callingObject.Name
3: callingObjectPath = callingObject.Path
4: If Not IsNothing(theCaller) Then
5: callerFullPath = theCaller
6: Caller = theCaller
7: If InStr(1, callerFullPath, "\") Then Caller = Mid$(callerFullPath, InStrRev(callerFullPath, "\") + 1)
End If
8: If Len(callerFullPath) = 0 Then
9: Caller = commonCaller
10: callerFullPath = callingObjectPath & "\" & commonCaller
End If
11: CallerInfo = "Caller: " & Caller & ",callerFullPath: " & callerFullPath
On Error GoTo setProperties_Err
12: If Not (IsNothing(theLogFilePath)) Then LogFilePath = theLogFilePath
13: If Len(LogFilePath) = 0 Then LogFilePath = callingObjectPath
' if no absolute path was given (drive mapping or unc), prepend callingObjectPath
14: If Left(LogFilePath, 2) <> "\\" And InStr(1, LogFilePath, ":") = 0 Then LogFilePath = callingObjectPath & "\" & LogFilePath
LogLevel = theLogLevel
15: If Not (IsNothing(theEnv)) Then env = theEnv
16: If Not (IsNothing(theMailRecipients)) Then mailRecipients = theMailRecipients
17: If Not (IsNothing(theSubject)) Then Subject = theSubject
18: doEventLog = writeToEventLog
19: If Not (IsNothing(theSender)) Then Sender = theSender
20: If Not (IsNothing(theMailIntro)) Then MailIntro = theMailIntro
21: If Not (IsNothing(theMailGreetings)) Then MailGreetings = theMailGreetings
22: If overrideCommonCaller Then commonCaller = theCaller
mirrorToStdOut = doMirrorToStdOut
If mirrorToStdOut AndAlso CmdLineFetcher.AppVisible Then ExcelDna.Logging.LogDisplay.Show()
If Boolean.Parse(CmdLineFetcher.fetchSetting("debug", "false")) Then LogToEventViewer("Logger.setProperties: commonCaller = " & commonCaller & ", callingObjectPath = " & callingObjectPath & ", callerFullPath = " & callerFullPath & "Caller = " & Caller & ", callingObject.Name = " & callingObject.Name & ", mirrorToStdOut = " & mirrorToStdOut & ", LogLevel = " & LogLevel & ", env =" & env & ", mailRecipients = " & mailRecipients & ", Subject = " & Subject & ", doEventLog = " & doEventLog & ", Sender = " & Sender & ", MailIntro = " & MailIntro & ", MailGreetings = " & MailGreetings, EventLogEntryType.Warning)
Exit Sub
setProperties_Err:
Dim ErrDesc As String : ErrDesc = "Error: " & Err.Description & ", line " & Erl() & " in Logger.setProperties"
LogToEventViewer(ErrDesc & ", commonCaller = " & commonCaller & ", callingObjectPath = " & callingObjectPath & ", callerFullPath = " & callerFullPath & "Caller = " & Caller & ", callingObject.Name = " & callingObject.Name & ", mirrorToStdOut = " & mirrorToStdOut & ", LogLevel = " & LogLevel & ", env =" & env & ", mailRecipients = " & mailRecipients & ", Subject = " & Subject & ", doEventLog = " & doEventLog & ", Sender = " & Sender & ", MailIntro = " & MailIntro & ", MailGreetings = " & MailGreetings)
End Sub
''' <summary>writes log information messages to defined Logfiles</summary>
''' <param name="LogMessage">Message to be logged</param>
''' <param name="LogPrio">priority level (ERROR 1, WARN 2, INFO 4, DEBUG 8 (SuccessAudit), FATAL 16 (FailureAudit))</param>
Private Sub LogWrite(LogMessage As String, LogPrio As EventLogEntryType)
Dim theLogFileStr, MailFileLink, FileMessage As String
FileMessage = ""
On Error GoTo LogWrite_Err
1: Dim timestamp = Date.Now().ToString(timeStampFormat, System.Globalization.CultureInfo.CreateSpecificCulture(timeStampCulture))
Dim i As Integer
2: For i = 0 To UBound(logentry)
3: If LCase$(logentry(i)) = "timestamp" Then FileMessage = FileMessage & timestamp & vbTab
4: If LCase$(logentry(i)) = "loglevel" Then FileMessage = FileMessage & Choose(LogPrio, "ERROR", "WARN", "", "INFO", "", "", "", "DEBUG", "", "", "", "", "", "", "", "FATAL") & vbTab
5: If LCase$(logentry(i)) = "caller" Then FileMessage = FileMessage & "file://" & Replace(callerFullPath, " ", "%20") & vbTab
6: If Left$(LCase$(logentry(i)), 2) = "e:" Then FileMessage = FileMessage & Environ$(Mid$(logentry(i), 3)) & vbTab
7: If LCase$(logentry(i)) = "logmessage" Then FileMessage = FileMessage & LogMessage & vbTab
Next
8: FileMessage = Left$(FileMessage, Len(FileMessage) - 1)
If doEventLog Then
9: LogToEventViewer(LogMessage, LogPrio, 0)
10: MailFileLink = "Log in Event Viewer on machine \\" & Environ$("COMPUTERNAME")
Else
11: theLogFileStr = IIf(Left$(LogFilePath, 2) = "\\" Or Mid$(LogFilePath, 2, 2) = ":\", "", callingObjectPath & "\") & LogFilePath & "\" & IIf(Len(env) > 0, env & "\", vbNullString) & commonCaller & ".log"
12: Dim outputFile As StreamWriter = New StreamWriter(theLogFileStr, True, System.Text.Encoding.Default)
13: outputFile.WriteLine(FileMessage)
14: outputFile.Close() ' close the file
15: MailFileLink = "Logfile in file://" & Replace(LogFilePath, " ", "%20") & "\" & IIf(Len(env) > 0, env & "\", vbNullString) & commonCaller & ".log"
End If
16: If Len(mailRecipients) > 0 And LogPrio = EventLogEntryType.Error And Not AlreadySent Then sendMail(FileMessage, MailFileLink)
Exit Sub
LogWrite_Err:
LogToEventViewer(IIf(doEventLog, "", "trying to Log to file: " & theLogFileStr) & ", Error: " & Err.Description & ", line " & Erl() & " in Logger.LogWrite")
End Sub
''' <summary>writes the log message LogMessage having appropriate priority (as shown in function name) and ends Excel</summary>
''' <param name="LogMessage"></param>
Public Sub LogFatal(LogMessage As String)
quittingApp = True
LogWrite(LogMessage, EventLogEntryType.FailureAudit)
If mirrorToStdOut AndAlso CmdLineFetcher.AppVisible Then Trace.TraceError("/Fatal " + Date.Now().ToString(timeStampFormat, System.Globalization.CultureInfo.CreateSpecificCulture(timeStampCulture)) + " " + LogMessage)
ExcelDnaUtil.Application.OnTime(DateTime.Now, "QuitApp")
End Sub
''' <summary>writes the log message LogMessage having appropriate priority (as shown in function name)</summary>
''' <param name="LogMessage"></param>
Public Sub LogError(LogMessage As String)
LogWrite(LogMessage, EventLogEntryType.Error)
If mirrorToStdOut AndAlso CmdLineFetcher.AppVisible Then Trace.TraceError(Date.Now().ToString(timeStampFormat, System.Globalization.CultureInfo.CreateSpecificCulture(timeStampCulture)) + " " + LogMessage)
End Sub
''' <summary>writes the log message LogMessage having appropriate priority (as shown in function name) depending on log level set</summary>
''' <param name="LogMessage"></param>
Public Sub LogWarn(LogMessage As String)
If LogLevel >= EventLogEntryType.Warning Then
LogWrite(LogMessage, EventLogEntryType.Warning)
If mirrorToStdOut AndAlso CmdLineFetcher.AppVisible Then Trace.TraceWarning(Date.Now().ToString(timeStampFormat, System.Globalization.CultureInfo.CreateSpecificCulture(timeStampCulture)) + " " + LogMessage)
End If
End Sub
''' <summary>writes the log message LogMessage having appropriate priority (as shown in function name) depending on log level set</summary>
''' <param name="LogMessage"></param>
Public Sub LogInfo(LogMessage As String)
If LogLevel >= EventLogEntryType.Information Then
LogWrite(LogMessage, EventLogEntryType.Information)
If mirrorToStdOut AndAlso CmdLineFetcher.AppVisible Then Trace.TraceInformation(Date.Now().ToString(timeStampFormat, System.Globalization.CultureInfo.CreateSpecificCulture(timeStampCulture)) + " " + LogMessage)
End If
End Sub
''' <summary>writes the log message LogMessage having appropriate priority (as shown in function name) depending on log level set</summary>
''' <param name="LogMessage"></param>
Public Sub LogDebug(LogMessage As String)
If LogLevel >= EventLogEntryType.SuccessAudit Then
LogWrite(LogMessage, EventLogEntryType.SuccessAudit)
If mirrorToStdOut AndAlso CmdLineFetcher.AppVisible Then Trace.TraceInformation("/Debug " + Date.Now().ToString(timeStampFormat, System.Globalization.CultureInfo.CreateSpecificCulture(timeStampCulture)) + " " + LogMessage)
End If
End Sub
''' <summary>Logs sErrMsg of eEventType in eCategory to EventLog</summary>
''' <param name="sErrMsg"></param>
''' <param name="eEventType"></param>
''' <param name="sendIntErrMail"></param>
Public Sub LogToEventViewer(sErrMsg As String, Optional eEventType As EventLogEntryType = EventLogEntryType.Error, Optional sendIntErrMail As Boolean = False)
Dim eventLog As EventLog = New EventLog("Application")
' .Net Runtime is always there if .Net is installed
EventLog.WriteEntry(".NET Runtime", sErrMsg, eEventType, 1000)
If sendIntErrMail Then sendMail(sErrMsg, "", True)
End Sub
''' <summary>sends an Error mail containing the logged line (logLine) And a hyperlink To the logfile (logPathMsg)</summary>
''' <param name="logLine"></param>
''' <param name="logPathMsg"></param>
''' <param name="internalErr"></param>
Private Sub sendMail(logLine As String, logPathMsg As String, Optional internalErr As Boolean = False)
' construct mail message
Dim theSubject As String = IIf(internalErr, "LogAddin Internal Error !", IIf(Len(Subject) = 0, defaultSubject, Subject))
Dim FromAddr As String = IIf(Len(Sender) = 0, defaultSender, Sender)
If Len(FromAddr) = 0 Then
LogToEventViewer("objMessage.From is empty, please ensure valid sender !")
Exit Sub
End If
Dim ToAddr As String = IIf(internalErr, cdoInternalErrMailRcpt, mailRecipients)
If Len(ToAddr) = 0 Then
LogToEventViewer("objMessage.To is empty, please ensure valid receiver !")
Exit Sub
End If
Dim TextBody As String = IIf(internalErr, "LogAddin Internal Error occurred (COMPUTERNAME:" & Environ$("COMPUTERNAME") & ",USERNAME:" & Environ$("USERNAME") & ",CallerInfo: " & CallerInfo & "): " & vbLf & vbLf & logLine, IIf(Len(MailIntro) = 0, defaultMailIntro, MailIntro) & "(executed in: " & commonCaller & ", current caller: " & Caller & "):" & vbLf & vbLf _
& logLine & vbLf & vbLf _
& logPathMsg & vbLf & vbLf _
& IIf(Len(MailGreetings) = 0, defaultMailGreetings, MailGreetings))
Dim objMessage As System.Net.Mail.MailMessage = New System.Net.Mail.MailMessage(FromAddr, ToAddr, theSubject, TextBody)
' send the message
Dim client As System.Net.Mail.SmtpClient = New System.Net.Mail.SmtpClient(cdoServerName, cdoServerPort)
' Add credentials if the SMTP server requires them.
Try
If cdoConnectiontimeout > 0 Then client.Timeout = cdoConnectiontimeout * 1000
client.Credentials = System.Net.CredentialCache.DefaultNetworkCredentials
client.Send(objMessage)
Catch ex As Exception
Try
client.EnableSsl = cdoUseSSL
client.UseDefaultCredentials = False
If cdoAuthentRequired Then client.Credentials = New System.Net.NetworkCredential(cdoUserID, cdoPassword)
client.Send(objMessage)
Catch ex1 As Exception
LogToEventViewer("Error: " & ex1.Message & " in Logger.sendMail; mailRecipients: " & mailRecipients & ",defaultSender: " & defaultSender & ",Sender: " & Sender & ",FromAddr: " & FromAddr)
End Try
End Try
AlreadySent = True
End Sub
End Class