diff --git a/CHANGELOG.md b/CHANGELOG.md index 3511fd4f..45c6d9a3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -28,6 +28,7 @@ Major Changes: - __4.0.17__ Add `FollowRedirects` and follow redirects by default, convert stored body to Variant, fix multiple 100 Continue bug - __4.0.18__ Add `VBA.Randomize` to `CreateNonce` and add `TodoistAuthenticator` - __4.0.19__ Fix installer and update VBA-JSON to v1.0.3 +- __4.0.20__ Update VBA-JSON to v2.0.1 (Note: Breaking change in VBA-JSON, Solidus is no longer escaped by default) Breaking Changes: diff --git a/README.md b/README.md index e6418c61..7d8b34da 100644 --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ VBA-Web (formerly Excel-REST) makes working with complex webservices and APIs ea Getting started --------------- -- Download the [latest release (v4.0.19)](https://github.com/VBA-tools/VBA-Web/releases) +- Download the [latest release (v4.0.20)](https://github.com/VBA-tools/VBA-Web/releases) - To install/upgrade in an existing file, use `VBA-Web - Installer.xlsm` - To start from scratch in Excel, `VBA-Web - Blank.xlsm` has everything setup and ready to go @@ -39,19 +39,19 @@ Function GetDirections(Origin As String, Destination As String) As String ' and set a base url that all requests will be appended to Dim MapsClient As New WebClient MapsClient.BaseUrl = "https://maps.googleapis.com/maps/api/" - + ' Use GetJSON helper to execute simple request and work with response Dim Resource As String Dim Response As WebResponse - + Resource = "directions/json?" & _ "origin=" & Origin & _ "&destination=" & Destination & _ "&sensor=false" Set Response = MapsClient.GetJSON(Resource) - + ' => GET https://maps.../api/directions/json?origin=...&destination=...&sensor=false - + ProcessDirections Response End Function @@ -70,13 +70,13 @@ Public Sub ProcessDirections(Response As WebResponse) End Sub ``` -There are 3 primary components in VBA-Web: +There are 3 primary components in VBA-Web: 1. `WebRequest` for defining complex requests 2. `WebClient` for executing requests -3. `WebResponse` for dealing with responses. - -In the above example, the request is fairly simple, so we can skip creating a `WebRequest` and instead use the `Client.GetJSON` helper to GET json from a specific url. In processing the response, we can look at the `StatusCode` to make sure the request succeeded and then use the parsed json in the `Data` parameter to extract complex information from the response. +3. `WebResponse` for dealing with responses. + +In the above example, the request is fairly simple, so we can skip creating a `WebRequest` and instead use the `Client.GetJSON` helper to GET json from a specific url. In processing the response, we can look at the `StatusCode` to make sure the request succeeded and then use the parsed json in the `Data` parameter to extract complex information from the response. ### WebRequest Example @@ -86,30 +86,30 @@ If you wish to have more control over the request, the following example uses `W Function GetDirections(Origin As String, Destination As String) As String Dim MapsClient As New WebClient MapsClient.BaseUrl = "https://maps.googleapis.com/maps/api/" - + ' Create a WebRequest for getting directions Dim DirectionsRequest As New WebRequest DirectionsRequest.Resource = "directions/{format}" DirectionsRequest.Method = WebMethod.HttpGet - - ' Set the request format + + ' Set the request format ' -> Sets content-type and accept headers and parses the response DirectionsRequest.Format = WebFormat.Json - + ' Replace {format} segment DirectionsRequest.AddUrlSegment "format", "json" - + ' Add querystring to the request DirectionsRequest.AddQuerystringParam "origin", Origin DirectionsRequest.AddQuerystringParam "destination", Destination DirectionsRequest.AddQuerystringParam "sensor", "false" - + ' => GET https://maps.../api/directions/json?origin=...&destination=...&sensor=false - + ' Execute the request and work with the response Dim Response As WebResponse Set Response = MapsClient.Execute(DirectionsRequest) - + ProcessDirections Response End Function @@ -138,14 +138,14 @@ The following example demonstrates using an authenticator with VBA-Web to query Function QueryTwitter(Query As String) As WebResponse Dim TwitterClient As New WebClient TwitterClient.BaseUrl = "https://api.twitter.com/1.1/" - + ' Setup authenticator Dim TwitterAuth As New TwitterAuthenticator TwitterAuth.Setup _ ConsumerKey:="Your consumer key", _ ConsumerSecret:="Your consumer secret" Set TwitterClient.Authenticator = TwitterAuth - + ' Setup query request Dim Request As New WebRequest Request.Resource = "search/tweets.json" @@ -154,10 +154,10 @@ Function QueryTwitter(Query As String) As WebResponse Request.AddParameter "q", Query Request.AddParameter "lang", "en" Request.AddParameter "count", 20 - + ' => GET https://api.twitter.com/1.1/search/tweets.json?q=...&lang=en&count=20 ' Authorization Bearer Token... (received and added automatically via TwitterAuthenticator) - + Set QueryTwitter = TwitterClient.Execute(Request) End Function ``` diff --git a/VBA-Web - Blank.xlsm b/VBA-Web - Blank.xlsm index 7cfdf66c..90f56345 100644 Binary files a/VBA-Web - Blank.xlsm and b/VBA-Web - Blank.xlsm differ diff --git a/VBA-Web - Installer.xlsm b/VBA-Web - Installer.xlsm index cb350d34..71ff213a 100644 Binary files a/VBA-Web - Installer.xlsm and b/VBA-Web - Installer.xlsm differ diff --git a/examples/VBA-Web - Example.xlsm b/examples/VBA-Web - Example.xlsm index 5c7360b7..d38dbd19 100644 Binary files a/examples/VBA-Web - Example.xlsm and b/examples/VBA-Web - Example.xlsm differ diff --git a/specs/VBA-Web - Specs - Async.xlsm b/specs/VBA-Web - Specs - Async.xlsm index 6c292a2c..2cf0b523 100644 Binary files a/specs/VBA-Web - Specs - Async.xlsm and b/specs/VBA-Web - Specs - Async.xlsm differ diff --git a/specs/VBA-Web - Specs.xlsm b/specs/VBA-Web - Specs.xlsm index 32e266cc..57790e4f 100644 Binary files a/specs/VBA-Web - Specs.xlsm and b/specs/VBA-Web - Specs.xlsm differ diff --git a/src/IWebAuthenticator.cls b/src/IWebAuthenticator.cls index 3043bf43..3a74fc55 100644 --- a/src/IWebAuthenticator.cls +++ b/src/IWebAuthenticator.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' IWebAuthenticator v4.0.19 +' IWebAuthenticator v4.0.20 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' Interface for creating authenticators for rest client diff --git a/src/WebAsyncWrapper.cls b/src/WebAsyncWrapper.cls index f9e6d46b..4ffc4e13 100644 --- a/src/WebAsyncWrapper.cls +++ b/src/WebAsyncWrapper.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' WebAsyncWrapper v4.0.19 +' WebAsyncWrapper v4.0.20 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' Wrapper WebClient and WebRequest that enables callback-style async requests @@ -84,7 +84,7 @@ Public Property Set Client(Value As WebClient) Dim web_ErrorDescription As String web_ErrorDescription = "The Client for a WebAsyncWrapper should not be changed as it may affect any currently executing Requests. " & _ "A new WebAsyncWrapper should be created for each WebClient." - + WebHelpers.LogError web_ErrorDescription, "WebAsyncWrapper.Client", vbObjectError + 11050 Err.Raise vbObjectError + 11050, "WebAsyncWrapper.Client", web_ErrorDescription End If @@ -107,7 +107,7 @@ Public Sub ExecuteAsync(Request As WebRequest, Callback As String, Optional ByVa ' - AsyncWrapper can only watch one WinHttpRequest's events ' - Callback + CallbackArgs would need to be stored per Request Dim web_Async As WebAsyncWrapper - + Set web_Async = Me.Clone web_Async.PrepareAndExecuteRequest Request, Callback, CallbackArgs End Sub @@ -138,19 +138,19 @@ Public Sub PrepareAndExecuteRequest(Request As WebRequest, Callback As String, O Me.Callback = Callback Me.CallbackArgs = CallbackArgs - + Set Me.Request = Request.Clone Set Me.Http = Me.Client.PrepareHttpRequest(Request) web_StartTimeoutTimer Me.Http.Send Request.Body Exit Sub - + web_ErrorHandling: - + Set Me.Http = Nothing Set Me.Request = Nothing - + ' Rethrow error Err.Raise Err.Number, Err.Source, Err.Description End Sub @@ -163,10 +163,10 @@ End Sub '' Public Sub TimedOut() Dim web_Response As New WebResponse - + web_StopTimeoutTimer WebHelpers.LogDebug "Timed out", "WebAsyncWrapper.TimedOut" - + ' Callback web_Response.StatusCode = WebStatusCode.RequestTimeout web_Response.StatusDescription = "Request Timeout" @@ -191,9 +191,9 @@ Private Sub web_RunCallback(web_Response As WebResponse) ' Debug.Print args(i) & " was passed into async execute" ' Next i ' End Function - + WebHelpers.LogResponse Me.Client, Me.Request, web_Response - + If Not Me.Client.Authenticator Is Nothing Then Me.Client.Authenticator.AfterExecute Me.Client, Me.Request, web_Response End If @@ -205,7 +205,7 @@ Private Sub web_RunCallback(web_Response As WebResponse) Application.Run Me.Callback, web_Response End If End If - + Set Me.Http = Nothing Set Me.Request = Nothing End Sub @@ -215,13 +215,13 @@ Private Sub web_StartTimeoutTimer() Dim web_TimeoutS As Long If WebHelpers.AsyncRequests Is Nothing Then: Set WebHelpers.AsyncRequests = New Dictionary - + ' Round ms to seconds with minimum of 1 second if ms > 0 web_TimeoutS = Round(Me.Client.TimeoutMs / 1000, 0) If Me.Client.TimeoutMs > 0 And web_TimeoutS = 0 Then web_TimeoutS = 1 End If - + WebHelpers.AsyncRequests.Add Me.Request.Id, Me Application.OnTime Now + TimeValue("00:00:" & web_TimeoutS), "'WebHelpers.OnTimeoutTimerExpired """ & Me.Request.Id & """'" End Sub @@ -238,9 +238,9 @@ End Sub ' Process asynchronous requests Private Sub Http_OnResponseFinished() Dim web_Response As New WebResponse - + web_StopTimeoutTimer - + ' Callback web_Response.CreateFromHttp Me.Client, Me.Request, Me.Http web_RunCallback web_Response diff --git a/src/WebClient.cls b/src/WebClient.cls index 36551573..a34ffd02 100644 --- a/src/WebClient.cls +++ b/src/WebClient.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' WebClient v4.0.19 +' WebClient v4.0.20 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' `WebClient` executes requests and handles response and is responsible for functionality shared between requests, @@ -242,22 +242,22 @@ End Property Public Function Execute(Request As WebRequest) As WebResponse Dim web_Http As Object Dim web_Response As New WebResponse - + On Error GoTo web_ErrorHandling - + #If Mac Then Dim web_Curl As String Dim web_Result As ShellResult - + web_Curl = Me.PrepareCurlRequest(Request) web_Result = WebHelpers.ExecuteInShell(web_Curl) - + ' Handle cURL errors If web_Result.ExitCode > 0 Then Dim web_ErrorNumber As Long Dim web_ErrorMessage As String web_ErrorNumber = web_Result.ExitCode / 256 - + Select Case web_ErrorNumber Case 1 ' 1 = CURLE_UNSUPPORTED_PROTOCOL @@ -284,42 +284,42 @@ Public Function Execute(Request As WebRequest) As WebResponse "Find details at http://curl.haxx.se/libcurl/c/libcurl-errors.html" End Select End If - + web_Response.CreateFromCurl Me, Request, web_Result.Output #Else Set web_Http = Me.PrepareHttpRequest(Request) - + web_Http.Send Request.Body Do While Not web_Http.WaitForResponse(25) VBA.DoEvents Loop - + web_Response.CreateFromHttp Me, Request, web_Http - + #End If WebHelpers.LogResponse Me, Request, web_Response - + If Not Me.Authenticator Is Nothing Then Me.Authenticator.AfterExecute Me, Request, web_Response End If - + Set web_Http = Nothing Set Execute = web_Response Exit Function - + web_ErrorHandling: Set web_Http = Nothing Dim web_ErrorDescription As String - + Select Case Err.Number - vbObjectError Case 208610, 208615, 208637 ' Return 408 web_Response.StatusCode = WebStatusCode.RequestTimeout web_Response.StatusDescription = "Request Timeout" - + WebHelpers.LogResponse Me, Request, web_Response Set Execute = web_Response Err.Clear @@ -327,7 +327,7 @@ web_ErrorHandling: ' Error web_ErrorDescription = "An error occurred during execute" & vbNewLine & _ Err.Number & VBA.IIf(Err.Number < 0, " (" & VBA.LCase$(VBA.Hex$(Err.Number)) & ")", "") & ": " & Err.Description - + WebHelpers.LogError web_ErrorDescription, "WebClient.Execute", 11011 + vbObjectError Err.Raise 11011 + vbObjectError, "WebClient.Execute", web_ErrorDescription End Select @@ -370,7 +370,7 @@ Public Function GetJson(Url As String, Optional Options As Dictionary) As WebRes web_Request.Resource = Url web_Request.Format = WebFormat.Json web_Request.Method = WebMethod.HttpGet - + Set GetJson = Me.Execute(web_Request) End Function @@ -422,7 +422,7 @@ Public Function PostJson(Url As String, Body As Variant, Optional Options As Dic Else web_Request.Body = Body End If - + Set PostJson = Me.Execute(web_Request) End Function @@ -451,7 +451,7 @@ End Function '' Public Sub SetProxy(ProxyServer As String, _ Optional Username As String = "", Optional Password As String = "", Optional BypassList As String = "") - + Me.ProxyServer = ProxyServer Me.ProxyUsername = Username Me.ProxyPassword = Password @@ -481,31 +481,31 @@ End Function Public Function PrepareHttpRequest(Request As WebRequest, Optional Async As Boolean = True) As Object Dim web_Http As Object Dim web_KeyValue As Dictionary - + On Error GoTo web_ErrorHandling - + Set web_Http = CreateObject("WinHttp.WinHttpRequest.5.1") - + ' Prepare request (before open) web_BeforeExecute Request - + ' Open http request web_Http.Open WebHelpers.MethodToName(Request.Method), Me.GetFullUrl(Request), Async - + ' Set timeouts web_Http.SetTimeouts Me.TimeoutMs, Me.TimeoutMs, Me.TimeoutMs, Me.TimeoutMs - + ' Load auto-proxy (if needed) If Me.EnableAutoProxy Then web_LoadAutoProxy Request End If - + ' Setup proxy ' See http://msdn.microsoft.com/en-us/library/windows/desktop/aa384059(v=vs.85).aspx for details If Me.ProxyServer <> "" Then WebHelpers.LogDebug "SetProxy: " & Me.ProxyServer, "WebClient.PrepareHttpRequest" web_Http.SetProxy web_HttpRequest_ProxySetting_Proxy, Me.ProxyServer, Me.ProxyBypassList - + If Me.ProxyUsername <> "" Then WebHelpers.LogDebug "SetProxyCredentials: " & Me.ProxyUsername & ", " & WebHelpers.Obfuscate(Me.ProxyPassword), "WebClient.PrepareHttpRequest" web_Http.SetCredentials Me.ProxyUsername, Me.ProxyPassword, web_HttpRequest_SetCredentials_ForProxy @@ -514,7 +514,7 @@ Public Function PrepareHttpRequest(Request As WebRequest, Optional Async As Bool ' Attempt to get proxy setup with Proxycfg.exe, otherwise direct web_Http.SetProxy web_HttpRequest_ProxySetting_PreConfig End If - + ' Setup security If Me.Insecure Then ' - Disable certifcate revocation check @@ -537,29 +537,29 @@ Public Function PrepareHttpRequest(Request As WebRequest, Optional Async As Bool web_Http.Option(web_WinHttpRequestOption.web_WinHttpRequestOption_SslErrorIgnoreFlags) = 0 web_Http.Option(web_WinHttpRequestOption.web_WinHttpRequestOption_EnableHttpsToHttpRedirects) = False End If - + ' Setup redirects web_Http.Option(web_WinHttpRequestOption.web_WinHttpRequestOption_EnableRedirects) = Me.FollowRedirects - + ' Set headers on http request (after open) For Each web_KeyValue In Request.Headers web_Http.SetRequestHeader web_KeyValue("Key"), web_KeyValue("Value") Next web_KeyValue - + For Each web_KeyValue In Request.Cookies web_Http.SetRequestHeader "Cookie", web_KeyValue("Key") & "=" & web_KeyValue("Value") Next web_KeyValue - + ' Give authenticator opportunity to update Http If Not Me.Authenticator Is Nothing Then Me.Authenticator.PrepareHttp Me, Request, web_Http End If - + ' Log request and return WebHelpers.LogRequest Me, Request Set PrepareHttpRequest = web_Http Exit Function - + web_ErrorHandling: Set web_Http = Nothing @@ -581,23 +581,23 @@ Public Function PrepareCurlRequest(Request As WebRequest) As String Dim web_Curl As String Dim web_KeyValue As Dictionary Dim web_CookieString As String - + On Error GoTo web_ErrorHandling - + web_Curl = "curl -i" - + ' Setup authenticator web_BeforeExecute Request - + ' Set timeouts ' (max time = resolve + sent + receive) web_Curl = web_Curl & " --connect-timeout " & Me.TimeoutMs / 1000 web_Curl = web_Curl & " --max-time " & 3 * Me.TimeoutMs / 1000 - + ' Setup proxy If Me.ProxyServer <> "" Then web_Curl = web_Curl & " --proxy " & Me.ProxyServer - + If Me.ProxyBypassList <> "" Then web_Curl = web_Curl & " --noproxy " & Me.ProxyBypassList End If @@ -605,44 +605,44 @@ Public Function PrepareCurlRequest(Request As WebRequest) As String web_Curl = web_Curl & " --proxy-user " & Me.ProxyUsername & ":" & Me.ProxyPassword End If End If - + ' Setup security If Me.Insecure Then web_Curl = web_Curl & " --insecure" End If - + ' Setup redirects If Me.FollowRedirects Then web_Curl = web_Curl & " --location" End If - + ' Set headers and cookies For Each web_KeyValue In Request.Headers web_Curl = web_Curl & " -H '" & web_KeyValue("Key") & ": " & web_KeyValue("Value") & "'" Next web_KeyValue - + For Each web_KeyValue In Request.Cookies web_CookieString = web_CookieString & web_KeyValue("Key") & "=" & web_KeyValue("Value") & ";" Next web_KeyValue If web_CookieString <> "" Then web_Curl = web_Curl & " --cookie '" & web_CookieString & "'" End If - + ' Add method, data, and url web_Curl = web_Curl & " -X " & WebHelpers.MethodToName(Request.Method) web_Curl = web_Curl & " -d '" & Request.Body & "'" web_Curl = web_Curl & " '" & Me.GetFullUrl(Request) & "'" - + ' Give authenticator opportunity to update cURL If Not Me.Authenticator Is Nothing Then Me.Authenticator.PrepareCurl Me, Request, web_Curl End If - + ' Log request and return WebHelpers.LogRequest Me, Request PrepareCurlRequest = web_Curl Exit Function - + web_ErrorHandling: Err.Raise 11013 + vbObjectError, "WebClient.PrepareCURLRequest", _ @@ -678,7 +678,7 @@ Private Sub web_BeforeExecute(web_Request As WebRequest) If Not Me.Authenticator Is Nothing Then Me.Authenticator.BeforeExecute Me, web_Request End If - + ' Preparing request includes adding headers ' -> Needs to happen after BeforeExecute in case headers were changed web_Request.Prepare @@ -687,7 +687,7 @@ End Sub Private Sub web_LoadAutoProxy(web_Request As WebRequest) #If Win32 Or Win64 Then On Error GoTo web_ErrorHandling - + Dim web_Parts As Dictionary Dim web_Domain As String Dim web_ProxyServer As String @@ -696,27 +696,27 @@ Private Sub web_LoadAutoProxy(web_Request As WebRequest) Set web_Parts = WebHelpers.GetUrlParts(Me.GetFullUrl(web_Request)) web_Domain = VBA.IIf(web_Parts("Protocol") <> "", web_Parts("Protocol") & "://", "") & _ web_Parts("Host") & ":" & web_Parts("Port") - + ' Cache auto-proxy by domain If web_Domain <> web_pAutoProxyDomain Then ' Cache first to store error as no proxy web_pAutoProxyDomain = web_Domain - + WebHelpers.GetAutoProxy web_Domain, web_ProxyServer, web_ProxyBypassList - + WebHelpers.LogDebug "Loaded auto-proxy for " & web_Domain & ":" & vbNewLine & _ "Server = " & web_ProxyServer & vbNewLine & _ "Bypass List = " & web_ProxyBypassList - + ' Store proxy server in underlying to avoid turning off auto-proxy web_pProxyServer = web_ProxyServer Me.ProxyBypassList = web_ProxyBypassList End If - + Exit Sub - + web_ErrorHandling: - + LogError "An error occurred while loading auto-proxy" & vbNewLine & _ Err.Number & VBA.IIf(Err.Number < 0, " (" & VBA.LCase$(VBA.Hex$(Err.Number)) & ")", "") & ": " & Err.Description, _ "WebClient.LoadAutoProxy", Err.Number diff --git a/src/WebHelpers.bas b/src/WebHelpers.bas index b39c9532..c3d1eccc 100644 --- a/src/WebHelpers.bas +++ b/src/WebHelpers.bas @@ -1,6 +1,6 @@ Attribute VB_Name = "WebHelpers" '' -' WebHelpers v4.0.19 +' WebHelpers v4.0.20 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' Contains general-purpose helpers that are used throughout VBA-Web. Includes: @@ -247,7 +247,7 @@ Private Declare Function web_fread Lib "libc.dylib" Alias "fread" (ByVal outStr Private Declare Function web_feof Lib "libc.dylib" Alias "feof" (ByVal File As Long) As Long #End If -Public Const WebUserAgent As String = "VBA-Web v4.0.19 (https://github.com/VBA-tools/VBA-Web)" +Public Const WebUserAgent As String = "VBA-Web v4.0.20 (https://github.com/VBA-tools/VBA-Web)" ' @internal Public Type ShellResult diff --git a/src/WebRequest.cls b/src/WebRequest.cls index d5a6be7b..2d41ec4b 100644 --- a/src/WebRequest.cls +++ b/src/WebRequest.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' WebRequest v4.0.19 +' WebRequest v4.0.20 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' `WebRequest` is used to create detailed requests @@ -228,7 +228,7 @@ End Property Public Property Let RequestFormat(Value As WebFormat) If Value <> web_pRequestFormat Then web_pRequestFormat = Value - + ' Clear cached converted body web_pConvertedBody = Empty End If @@ -264,7 +264,7 @@ End Property Public Property Let ResponseFormat(Value As WebFormat) If Value <> web_pResponseFormat Then web_pResponseFormat = Value - + ' Clear cached converted body web_pConvertedBody = Empty End If @@ -296,10 +296,10 @@ End Property Public Property Let CustomRequestFormat(Value As String) If Value <> web_pCustomRequestFormat Then web_pCustomRequestFormat = Value - + ' Clear cached converted body web_pConvertedBody = Empty - + If Value <> "" Then web_pRequestFormat = WebFormat.Custom End If @@ -332,10 +332,10 @@ End Property Public Property Let CustomResponseFormat(Value As String) If Value <> web_pCustomResponseFormat Then web_pCustomResponseFormat = Value - + ' Clear cached converted body web_pConvertedBody = Empty - + If Value <> "" Then ResponseFormat = WebFormat.Custom End If @@ -497,14 +497,14 @@ End Property '' Public Property Get FormattedResource() As String Dim web_Segment As Variant - + FormattedResource = Me.Resource - + ' Replace url segments For Each web_Segment In Me.UrlSegments.Keys FormattedResource = VBA.Replace(FormattedResource, "{" & web_Segment & "}", WebHelpers.UrlEncode(Me.UrlSegments(web_Segment))) Next web_Segment - + ' Add querystring If Me.QuerystringParams.Count > 0 Then If VBA.InStr(FormattedResource, "?") <= 0 Then @@ -512,7 +512,7 @@ Public Property Get FormattedResource() As String Else FormattedResource = FormattedResource & "&" End If - + FormattedResource = FormattedResource & WebHelpers.ConvertToUrlEncoded(Me.QuerystringParams) End If End Property @@ -685,11 +685,11 @@ Public Sub AddBodyParameter(Key As Variant, Value As Variant) ElseIf Not TypeOf web_pBody Is Dictionary Then Dim web_ErrorDescription As String web_ErrorDescription = "Cannot add body parameter to non-Dictionary Body (existing Body must be of type Dictionary)" - + WebHelpers.LogError web_ErrorDescription, "WebRequest.AddBodyParameter", 11020 + vbObjectError Err.Raise 11020 + vbObjectError, "WebRequest.AddBodyParameter", web_ErrorDescription End If - + If VBA.IsObject(Value) Then Set web_pBody(Key) = Value Else @@ -723,7 +723,7 @@ End Sub '' Public Function Clone() As WebRequest Set Clone = New WebRequest - + ' Note: Clone underlying for properties with default values Clone.Resource = Me.Resource Clone.Method = Me.Method @@ -734,12 +734,12 @@ Public Function Clone() As WebRequest Clone.ResponseFormat = Me.ResponseFormat Clone.CustomRequestFormat = Me.CustomRequestFormat Clone.CustomResponseFormat = Me.CustomResponseFormat - + Set Clone.Headers = WebHelpers.CloneCollection(Me.Headers) Set Clone.QuerystringParams = WebHelpers.CloneCollection(Me.QuerystringParams) Set Clone.UrlSegments = WebHelpers.CloneDictionary(Me.UrlSegments) Set Clone.Cookies = WebHelpers.CloneCollection(Me.Cookies) - + If VBA.IsObject(web_pBody) Then Set Clone.Body = web_pBody Else @@ -782,7 +782,7 @@ Private Sub Class_Initialize() ' Set default values Me.RequestFormat = WebFormat.Json Me.ResponseFormat = WebFormat.Json - + Set Me.Headers = New Collection Set Me.QuerystringParams = New Collection Set Me.UrlSegments = New Dictionary diff --git a/src/WebResponse.cls b/src/WebResponse.cls index cc428875..8591a07a 100644 --- a/src/WebResponse.cls +++ b/src/WebResponse.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' WebResponse v4.0.19 +' WebResponse v4.0.20 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' Wrapper for http/cURL responses that includes parsed Data based on WebRequest.ResponseFormat. @@ -133,14 +133,14 @@ End Sub '' Public Sub CreateFromHttp(Client As WebClient, Request As WebRequest, Http As Object) On Error GoTo web_ErrorHandling - + Me.StatusCode = Http.Status Me.StatusDescription = Http.StatusText Me.Content = Http.ResponseText Me.Body = Http.ResponseBody - + web_LoadValues Http.GetAllResponseHeaders, Me.Content, Me.Body, Request - + Exit Sub web_ErrorHandling: @@ -165,26 +165,26 @@ End Sub '' Public Sub CreateFromCurl(Client As WebClient, Request As WebRequest, Result As String) On Error GoTo web_ErrorHandling - + Dim web_Lines() As String - + web_Lines = VBA.Split(Result, vbCrLf) - + Me.StatusCode = web_ExtractStatusFromCurlResponse(web_Lines) Me.StatusDescription = web_ExtractStatusTextFromCurlResponse(web_Lines) Me.Content = web_ExtractResponseTextFromCurlResponse(web_Lines) Me.Body = WebHelpers.StringToAnsiBytes(Me.Content) - + web_LoadValues web_ExtractHeadersFromCurlResponse(web_Lines), Me.Content, Me.Body, Request - + Exit Sub - + web_ErrorHandling: - + Dim web_ErrorDescription As String web_ErrorDescription = "An error occurred while creating response from cURL" & vbNewLine & _ Err.Number & VBA.IIf(Err.Number < 0, " (" & VBA.LCase$(VBA.Hex$(Err.Number)) & ")", "") & ": " & Err.Description - + WebHelpers.LogError web_ErrorDescription, "WebResponse.CreateFromCurl", 11031 + vbObjectError Err.Raise 11031 + vbObjectError, "WebResponse.CreateFromCurl", web_ErrorDescription End Sub @@ -200,16 +200,16 @@ End Sub '' Public Function ExtractHeaders(ResponseHeaders As String) As Collection On Error GoTo web_ErrorHandling - + Dim web_Lines As Variant Dim web_i As Integer Dim web_Headers As New Collection Dim web_Header As Dictionary Dim web_ColonPosition As Long Dim web_Multiline As Boolean - + web_Lines = VBA.Split(ResponseHeaders, vbCrLf) - + For web_i = LBound(web_Lines) To (UBound(web_Lines) + 1) If web_i > UBound(web_Lines) Then web_Headers.Add web_Header @@ -226,7 +226,7 @@ Public Function ExtractHeaders(ResponseHeaders As String) As Collection ' Add previous header web_Headers.Add web_Header End If - + If Not web_Multiline Then Set web_Header = WebHelpers.CreateKeyValue( _ Key:=VBA.Trim(VBA.Mid$(web_Lines(web_i), 1, web_ColonPosition - 1)), _ @@ -237,16 +237,16 @@ Public Function ExtractHeaders(ResponseHeaders As String) As Collection End If End If Next web_i - + Set ExtractHeaders = web_Headers Exit Function - + web_ErrorHandling: - + Dim web_ErrorDescription As String web_ErrorDescription = "An error occurred while extracting headers" & vbNewLine & _ Err.Number & VBA.IIf(Err.Number < 0, " (" & VBA.LCase$(VBA.Hex$(Err.Number)) & ")", "") & ": " & Err.Description - + WebHelpers.LogError web_ErrorDescription, "WebResponse.CreateFromCurl", 11032 + vbObjectError Err.Raise 11032 + vbObjectError, "WebResponse.CreateFromCurl", web_ErrorDescription End Function @@ -265,24 +265,24 @@ Public Function ExtractCookies(Headers As Collection) As Collection Dim web_Key As String Dim web_Value As String Dim web_Cookies As New Collection - + For Each web_Header In Headers If web_Header("Key") = "Set-Cookie" Then web_Cookie = web_Header("Value") If VBA.InStr(1, web_Cookie, "=") > 0 Then web_Key = VBA.Mid$(web_Cookie, 1, VBA.InStr(1, web_Cookie, "=") - 1) web_Value = VBA.Mid$(web_Cookie, VBA.InStr(1, web_Cookie, "=") + 1, VBA.Len(web_Cookie)) - + ' Ignore text after semi-colon If VBA.InStr(1, web_Value, ";") > 0 Then web_Value = VBA.Mid$(web_Value, 1, VBA.InStr(1, web_Value, ";") - 1) End If - + ' Ignore surrounding quotes If VBA.Left$(web_Value, 1) = """" Then web_Value = VBA.Mid$(web_Value, 2, VBA.Len(web_Value) - 2) End If - + web_Cookies.Add WebHelpers.CreateKeyValue(web_Key, WebHelpers.UrlDecode(web_Value, PlusAsSpace:=False)) Else WebHelpers.LogWarning _ @@ -290,7 +290,7 @@ Public Function ExtractCookies(Headers As Collection) As Collection End If End If Next web_Header - + Set ExtractCookies = web_Cookies End Function @@ -304,24 +304,24 @@ Private Sub web_LoadValues(web_Headers As String, web_Content As String, web_Bod On Error Resume Next Set Me.Data = _ WebHelpers.ParseByFormat(web_Content, web_Request.ResponseFormat, web_Request.CustomResponseFormat, web_Body) - + If Err.Number <> 0 Then WebHelpers.LogError Err.Description, Err.Source, Err.Number Err.Clear End If On Error GoTo 0 End If - + ' Extract headers Set Me.Headers = ExtractHeaders(web_Headers) - + ' Extract cookies Set Me.Cookies = ExtractCookies(Me.Headers) End Sub Private Function web_ExtractStatusFromCurlResponse(web_CurlResponseLines() As String) As Long Dim web_StatusLineParts() As String - + web_StatusLineParts = VBA.Split(web_CurlResponseLines(web_FindStatusLine(web_CurlResponseLines)), " ") web_ExtractStatusFromCurlResponse = VBA.CLng(web_StatusLineParts(1)) End Function @@ -330,7 +330,7 @@ Private Function web_ExtractStatusTextFromCurlResponse(web_CurlResponseLines() A Dim web_StatusLineParts() As String Dim web_i As Long Dim web_StatusText As String - + web_StatusLineParts = VBA.Split(web_CurlResponseLines(web_FindStatusLine(web_CurlResponseLines)), " ", 3) web_ExtractStatusTextFromCurlResponse = web_StatusLineParts(2) End Function @@ -341,20 +341,20 @@ Private Function web_ExtractHeadersFromCurlResponse(web_CurlResponseLines() As S Dim web_HeaderLines() As String Dim web_WriteIndex As Long Dim web_ReadIndex As Long - + ' Find status line and blank line before body web_StatusLineIndex = web_FindStatusLine(web_CurlResponseLines) web_BlankLineIndex = web_FindBlankLine(web_CurlResponseLines) - + ' Extract headers string ReDim web_HeaderLines(0 To web_BlankLineIndex - 2 - web_StatusLineIndex) - + web_WriteIndex = 0 For web_ReadIndex = (web_StatusLineIndex + 1) To web_BlankLineIndex - 1 web_HeaderLines(web_WriteIndex) = web_CurlResponseLines(web_ReadIndex) web_WriteIndex = web_WriteIndex + 1 Next web_ReadIndex - + web_ExtractHeadersFromCurlResponse = VBA.Join$(web_HeaderLines, vbCrLf) End Function @@ -363,19 +363,19 @@ Private Function web_ExtractResponseTextFromCurlResponse(web_CurlResponseLines() Dim web_BodyLines() As String Dim web_WriteIndex As Long Dim web_ReadIndex As Long - + ' Find blank line before body web_BlankLineIndex = web_FindBlankLine(web_CurlResponseLines) - + ' Extract body string ReDim web_BodyLines(0 To UBound(web_CurlResponseLines) - web_BlankLineIndex - 1) - + web_WriteIndex = 0 For web_ReadIndex = web_BlankLineIndex + 1 To UBound(web_CurlResponseLines) web_BodyLines(web_WriteIndex) = web_CurlResponseLines(web_ReadIndex) web_WriteIndex = web_WriteIndex + 1 Next web_ReadIndex - + web_ExtractResponseTextFromCurlResponse = VBA.Join$(web_BodyLines, vbCrLf) End Function