From 3b680064fa1bc920c920f617f26143f088c04ea8 Mon Sep 17 00:00:00 2001 From: Sophist Date: Fri, 18 Mar 2016 18:45:42 +0000 Subject: [PATCH 1/5] Log to file as well as immediate window This PR adds functionality to write the same log messages to a file as well as to the VBA immediate window. --- src/WebHelpers.bas | 115 +++++++++++++++++++++++++++++++++++++++------ 1 file changed, 100 insertions(+), 15 deletions(-) diff --git a/src/WebHelpers.bas b/src/WebHelpers.bas index fb1d56f7..774df384 100644 --- a/src/WebHelpers.bas +++ b/src/WebHelpers.bas @@ -380,6 +380,24 @@ End Enum '' Public EnableLogging As Boolean +' @property EnableFileLogging +' @type Boolean +' @default False +'' +Public EnableFileLogging As Boolean + +' @property LogFile +' @type String +' @default "" +'' +Public LogFile As String + +' @property LogFileNumber +' @type Integer +' @default 0 +'' +Private LogFileNumber As Integer + '' ' Store currently running async requests ' @@ -414,6 +432,9 @@ Public Sub LogDebug(Message As String, Optional From As String = "VBA-Web") If EnableLogging Then Debug.Print From & ": " & Message End If + If EnableLogging Or EnableFileLogging Then + LogWrite "D", Message, From + End If End Sub '' @@ -436,6 +457,7 @@ End Sub '' Public Sub LogWarning(Message As String, Optional From As String = "VBA-Web") Debug.Print "WARNING - " & From & ": " & Message + LogWrite "W", Message, From End Sub '' @@ -473,6 +495,7 @@ Public Sub LogError(Message As String, Optional From As String = "VBA-Web", Opti End If Debug.Print "ERROR - " & From & ": " & web_ErrorValue & Message + LogWrite "E", web_ErrorValue & Message, From End Sub '' @@ -483,24 +506,31 @@ End Sub ' @param {WebRequest} Request '' Public Sub LogRequest(Client As WebClient, Request As WebRequest) - If EnableLogging Then - Debug.Print "--> Request - " & Format(Now, "Long Time") - Debug.Print MethodToName(Request.Method) & " " & Client.GetFullUrl(Request) + If EnableLogging Or EnableFileLogging Then + Dim msg As String + msg = "--> Request - " & Format(Now, "Long Time") & vbNewLine + msg = msg & MethodToName(Request.Method) & " " & Client.GetFullUrl(Request) & vbNewLine Dim web_KeyValue As Dictionary For Each web_KeyValue In Request.Headers - Debug.Print web_KeyValue("Key") & ": " & web_KeyValue("Value") + msg = msg & web_KeyValue("Key") & ": " & web_KeyValue("Value") & vbNewLine Next web_KeyValue For Each web_KeyValue In Request.Cookies - Debug.Print "Cookie: " & web_KeyValue("Key") & "=" & web_KeyValue("Value") + msg = msg & "Cookie: " & web_KeyValue("Key") & "=" & web_KeyValue("Value") & vbNewLine Next web_KeyValue If Not IsEmpty(Request.Body) Then - Debug.Print vbNewLine & CStr(Request.Body) + msg = msg & vbNewLine & CStr(Request.Body) & vbNewLine End If - Debug.Print + msg = msg & vbNewLine + End If + If EnableLogging Then + Debug.Print msg + End If + If EnableLogging Or EnableFileLogging Then + LogWrite "D", msg, "WebHelpers.LogRequest" End If End Sub @@ -513,22 +543,77 @@ End Sub ' @param {WebResponse} Response '' Public Sub LogResponse(Client As WebClient, Request As WebRequest, Response As WebResponse) - If EnableLogging Then - Dim web_KeyValue As Dictionary - - Debug.Print "<-- Response - " & Format(Now, "Long Time") - Debug.Print Response.StatusCode & " " & Response.StatusDescription + If EnableLogging Or EnableFileLogging Then + Dim msg As String + msg = "<-- Response - " & Format(Now, "Long Time") & vbNewLine + msg = msg & Response.StatusCode & " " & Response.StatusDescription & vbNewLine + Dim web_KeyValue As Dictionary For Each web_KeyValue In Response.Headers - Debug.Print web_KeyValue("Key") & ": " & web_KeyValue("Value") + msg = msg & web_KeyValue("Key") & ": " & web_KeyValue("Value") & vbNewLine Next web_KeyValue For Each web_KeyValue In Response.Cookies - Debug.Print "Cookie: " & web_KeyValue("Key") & "=" & web_KeyValue("Value") + msg = msg & "Cookie: " & web_KeyValue("Key") & "=" & web_KeyValue("Value") * vbNewLine Next web_KeyValue - Debug.Print vbNewLine & Response.Content & vbNewLine + msg = msg & vbNewLine & Response.Content & vbNewLine + End If + If EnableLogging Then + Debug.Print msg + End If + If EnableLogging Or EnableFileLogging Then + LogWrite "D", msg, "WebHelpers.LogResponse" + End If +End Sub + +'' +' Log a message to a log file if specified. +' +' @param {String} LogType (E=Error, W=Warning, D=Debug) +' @param {String} Message +' @param {String} From +' @return {String} +'' +Private Sub LogWrite(ByVal LogType As String, ByVal Message As String, ByVal From As String) + If LogFile <> "" Then + If LogFileNumber < 0 Then + LogFileNumber = LogFileNumber + 1 + Exit Sub + End If + + If LogFileNumber = 0 Then + On Error GoTo FileOpenError + LogFileNumber = FreeFile + Open LogFile For Append Access Write Lock Write As #LogFileNumber + On Error GoTo 0 + End If + + Dim Lines() As String + Dim msg As Variant + Lines = split(Message, vbNewLine) + On Error GoTo FileWriteError + For Each msg In Lines + msg = Replace(msg, """", "'") + If Trim(msg) <> "" Then _ + Write #LogFileNumber, LogType, Format(Now, "General Date"), From, Trim(msg) + Next msg End If + Exit Sub + +FileOpenError: + Debug.Print "ERROR: Unable to open logfile '" & LogFile & "' for Append Write: Error " & Err.Number & ": " & Err.Description + LogFileNumber = -100 + Err.Clear + Exit Sub + +FileWriteError: + Debug.Print "ERROR: Unable to write to logfile '" & LogFile & "': Error " & Err.Number & ": " & Err.Description + Close #LogFileNumber + LogFileNumber = 0 + Err.Clear + Exit Sub + End Sub '' From 95ef91567a4ca8d7a4c5433ea6b405596ce23b7a Mon Sep 17 00:00:00 2001 From: Sophist Date: Tue, 22 Mar 2016 09:57:04 +0000 Subject: [PATCH 2/5] Add ability to close the log For performance reasons the log file is held open unless the project is reset. This commit adds a method to close the log file in order to allow programmatic changes to the log file location. --- src/WebHelpers.bas | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/WebHelpers.bas b/src/WebHelpers.bas index 774df384..eead6d2c 100644 --- a/src/WebHelpers.bas +++ b/src/WebHelpers.bas @@ -567,6 +567,17 @@ Public Sub LogResponse(Client As WebClient, Request As WebRequest, Response As W End If End Sub +'' +' Close the log file if open. +' +'' +Public Sub LogClose() + If LogFile <> "" And LogFileNumber > 0 Then + Close #LogFileNumber + LogFileNumber = 0 + End If +End Sub + '' ' Log a message to a log file if specified. ' From d4d1ec94a009875711c1ab80c6f6bf9c97224a6d Mon Sep 17 00:00:00 2001 From: Sophist Date: Tue, 22 Mar 2016 10:00:34 +0000 Subject: [PATCH 3/5] Remove incorrect method doc. --- src/WebHelpers.bas | 1 - 1 file changed, 1 deletion(-) diff --git a/src/WebHelpers.bas b/src/WebHelpers.bas index eead6d2c..4274286a 100644 --- a/src/WebHelpers.bas +++ b/src/WebHelpers.bas @@ -584,7 +584,6 @@ End Sub ' @param {String} LogType (E=Error, W=Warning, D=Debug) ' @param {String} Message ' @param {String} From -' @return {String} '' Private Sub LogWrite(ByVal LogType As String, ByVal Message As String, ByVal From As String) If LogFile <> "" Then From 33011c05a77ca9d6c1a99ac05f1a62654577b1e0 Mon Sep 17 00:00:00 2001 From: Sophist Date: Tue, 22 Mar 2016 17:09:10 +0000 Subject: [PATCH 4/5] Avoid appearing as a macro to run Public Sub without args are available to run as a macro from the Outlook UI. --- src/WebHelpers.bas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/WebHelpers.bas b/src/WebHelpers.bas index 4274286a..ce1aca4c 100644 --- a/src/WebHelpers.bas +++ b/src/WebHelpers.bas @@ -571,7 +571,7 @@ End Sub ' Close the log file if open. ' '' -Public Sub LogClose() +Public Sub LogClose(Optional ByVal Dummy as Boolean) If LogFile <> "" And LogFileNumber > 0 Then Close #LogFileNumber LogFileNumber = 0 From ce1e290024a153c3847d1176c533cbc8ba116be5 Mon Sep 17 00:00:00 2001 From: Sophist Date: Wed, 30 Mar 2016 20:17:10 +0100 Subject: [PATCH 5/5] Add ForcePrint option to LogDebug Avoid having separate Debug.Print statements in order to print debugging regardless of EnableLogging or file logging. --- src/WebHelpers.bas | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/WebHelpers.bas b/src/WebHelpers.bas index ce1aca4c..a1e7d221 100644 --- a/src/WebHelpers.bas +++ b/src/WebHelpers.bas @@ -427,9 +427,10 @@ Public AsyncRequests As Dictionary ' @method LogDebug ' @param {String} Message ' @param {String} [From="VBA-Web"] +' @param {Boolean} ForcePrint '' -Public Sub LogDebug(Message As String, Optional From As String = "VBA-Web") - If EnableLogging Then +Public Sub LogDebug(Message As String, Optional From As String = "VBA-Web", Optional ForcePrint as Boolean) + If EnableLogging Or ForcePrint Then Debug.Print From & ": " & Message End If If EnableLogging Or EnableFileLogging Then