diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 00000000..1ef8019b --- /dev/null +++ b/.editorconfig @@ -0,0 +1,11 @@ +[*] +indent_style = space +indent_size = 2 +end_of_line = lf +trim_trailing_whitespace = true +insert_final_newline = true +charset = utf-8 + +[*.{bas,cls}] +indent_size = 4 +end_of_line = crlf diff --git a/.github/FUNDING.yml b/.github/FUNDING.yml new file mode 100644 index 00000000..604161a9 --- /dev/null +++ b/.github/FUNDING.yml @@ -0,0 +1,2 @@ +# github: # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2] +patreon: timhall diff --git a/CHANGELOG.md b/CHANGELOG.md index 261e74a3..0a6cb454 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +# 4.2.0 + +- Add `Accept-Encoding` header ("identity" by default) +- Include `Content-Type` and `Content-Length` for GET requests with non-empty `Body` +- Allow async timeouts >60 seconds + # 4.1.0 - Update `UrlEncode` behavior to target different encoding RFCs based on `UrlEncodingMode` @@ -9,6 +15,11 @@ - `UrlEncodingMode.PathUrlEncoding` uses "pchar" from [RFC 3986](https://tools.ietf.org/html/rfc3986) and is the default - Update VBA-JSON to v2.2.2 - __4.1.1__ Adjust `CookieUrlEncoding` mode to match value encoding in RFC 6265 (rather than name encoding) +- __4.1.2__ Compatibility with 64-bit Mac +- __4.1.3__ Mac bugfix for % encoding +- __4.1.4__ Fix compilation issues for 64-bit Mac +- __4.1.5__ Update VBA-JSON to v2.3.0 (fixes JSON slowdown on Windows) +- __4.1.6__ Fix libc bug in Mac 16.21.1 # 4.0.0 diff --git a/LICENSE b/LICENSE index 264bf8f0..9f4e8752 100644 --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2016 Tim Hall +Copyright (c) 2016-2019 Tim Hall Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/README.md b/README.md index 62982fd2..9740860d 100644 --- a/README.md +++ b/README.md @@ -3,10 +3,14 @@ VBA-Web VBA-Web (formerly Excel-REST) makes working with complex webservices and APIs easy with VBA on Windows and Mac. It includes support for authentication, automatically converting and parsing JSON, working with cookies and headers, and much more. + + Donate + + Getting started --------------- -- Download the [latest release (v4.1.1)](https://github.com/VBA-tools/VBA-Web/releases) +- Download the [latest release (v4.1.6)](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 diff --git a/VBA-Web - Blank.xlsm b/VBA-Web - Blank.xlsm index b7bfecdc..4f8a35f9 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 8702b763..56b6533f 100644 Binary files a/VBA-Web - Installer.xlsm and b/VBA-Web - Installer.xlsm differ diff --git a/docs/Gemfile b/docs/Gemfile index 190fa96e..00c28dc8 100644 --- a/docs/Gemfile +++ b/docs/Gemfile @@ -1,3 +1,3 @@ source 'https://rubygems.org' gem 'wdm', '~> 0.1.0' if Gem.win_platform? -gem 'github-pages', '109', group: :jekyll_plugins +gem 'github-pages', group: :jekyll_plugins diff --git a/docs/Gemfile.lock b/docs/Gemfile.lock index b93a48b8..1eae13d6 100644 --- a/docs/Gemfile.lock +++ b/docs/Gemfile.lock @@ -1,166 +1,250 @@ GEM remote: https://rubygems.org/ specs: - activesupport (4.2.7) + activesupport (4.2.10) i18n (~> 0.7) - json (~> 1.7, >= 1.7.7) minitest (~> 5.1) thread_safe (~> 0.3, >= 0.3.4) tzinfo (~> 1.1) - addressable (2.5.0) - public_suffix (~> 2.0, >= 2.0.2) + addressable (2.5.2) + public_suffix (>= 2.0.2, < 4.0) coffee-script (2.4.1) coffee-script-source execjs coffee-script-source (1.11.1) colorator (1.1.0) - ethon (0.10.1) + commonmarker (0.17.13) + ruby-enum (~> 0.5) + concurrent-ruby (1.1.4) + dnsruby (1.61.2) + addressable (~> 2.5) + em-websocket (0.5.1) + eventmachine (>= 0.12.9) + http_parser.rb (~> 0.6.0) + ethon (0.12.0) ffi (>= 1.3.0) + eventmachine (1.2.7-x64-mingw32) execjs (2.7.0) - faraday (0.10.0) + faraday (0.15.4) multipart-post (>= 1.2, < 3) - ffi (1.9.14-x64-mingw32) + ffi (1.10.0-x64-mingw32) forwardable-extended (2.6.0) - gemoji (2.1.0) - github-pages (109) - activesupport (= 4.2.7) - github-pages-health-check (= 1.3.0) - jekyll (= 3.3.1) - jekyll-avatar (= 0.4.2) - jekyll-coffeescript (= 1.0.1) + gemoji (3.0.0) + github-pages (193) + activesupport (= 4.2.10) + github-pages-health-check (= 1.8.1) + jekyll (= 3.7.4) + jekyll-avatar (= 0.6.0) + jekyll-coffeescript (= 1.1.1) + jekyll-commonmark-ghpages (= 0.1.5) jekyll-default-layout (= 0.1.4) - jekyll-feed (= 0.8.0) - jekyll-gist (= 1.4.0) - jekyll-github-metadata (= 2.2.0) - jekyll-mentions (= 1.2.0) - jekyll-optional-front-matter (= 0.1.2) + jekyll-feed (= 0.11.0) + jekyll-gist (= 1.5.0) + jekyll-github-metadata (= 2.9.4) + jekyll-mentions (= 1.4.1) + jekyll-optional-front-matter (= 0.3.0) jekyll-paginate (= 1.1.0) - jekyll-readme-index (= 0.0.3) - jekyll-redirect-from (= 0.11.0) - jekyll-relative-links (= 0.2.1) - jekyll-sass-converter (= 1.3.0) - jekyll-seo-tag (= 2.1.0) - jekyll-sitemap (= 0.12.0) + jekyll-readme-index (= 0.2.0) + jekyll-redirect-from (= 0.14.0) + jekyll-relative-links (= 0.5.3) + jekyll-remote-theme (= 0.3.1) + jekyll-sass-converter (= 1.5.2) + jekyll-seo-tag (= 2.5.0) + jekyll-sitemap (= 1.2.0) jekyll-swiss (= 0.4.0) - jekyll-theme-primer (= 0.1.1) - jekyll-titles-from-headings (= 0.1.2) - jemoji (= 0.7.0) - kramdown (= 1.11.1) - liquid (= 3.0.6) - listen (= 3.0.6) + jekyll-theme-architect (= 0.1.1) + jekyll-theme-cayman (= 0.1.1) + jekyll-theme-dinky (= 0.1.1) + jekyll-theme-hacker (= 0.1.1) + jekyll-theme-leap-day (= 0.1.1) + jekyll-theme-merlot (= 0.1.1) + jekyll-theme-midnight (= 0.1.1) + jekyll-theme-minimal (= 0.1.1) + jekyll-theme-modernist (= 0.1.1) + jekyll-theme-primer (= 0.5.3) + jekyll-theme-slate (= 0.1.1) + jekyll-theme-tactile (= 0.1.1) + jekyll-theme-time-machine (= 0.1.1) + jekyll-titles-from-headings (= 0.5.1) + jemoji (= 0.10.1) + kramdown (= 1.17.0) + liquid (= 4.0.0) + listen (= 3.1.5) mercenary (~> 0.3) - minima (= 2.0.0) - rouge (= 1.11.1) + minima (= 2.5.0) + nokogiri (>= 1.8.2, < 2.0) + rouge (= 2.2.1) terminal-table (~> 1.4) - github-pages-health-check (1.3.0) + github-pages-health-check (1.8.1) addressable (~> 2.3) - net-dns (~> 0.8) + dnsruby (~> 1.60) octokit (~> 4.0) public_suffix (~> 2.0) - typhoeus (~> 0.7) - html-pipeline (2.4.2) + typhoeus (~> 1.3) + html-pipeline (2.10.0) activesupport (>= 2) nokogiri (>= 1.4) - i18n (0.7.0) - jekyll (3.3.1) + http_parser.rb (0.6.0) + i18n (0.9.5) + concurrent-ruby (~> 1.0) + jekyll (3.7.4) addressable (~> 2.4) colorator (~> 1.0) + em-websocket (~> 0.5) + i18n (~> 0.7) jekyll-sass-converter (~> 1.0) - jekyll-watch (~> 1.1) - kramdown (~> 1.3) - liquid (~> 3.0) + jekyll-watch (~> 2.0) + kramdown (~> 1.14) + liquid (~> 4.0) mercenary (~> 0.3.3) pathutil (~> 0.9) - rouge (~> 1.7) + rouge (>= 1.7, < 4) safe_yaml (~> 1.0) - jekyll-avatar (0.4.2) + jekyll-avatar (0.6.0) jekyll (~> 3.0) - jekyll-coffeescript (1.0.1) + jekyll-coffeescript (1.1.1) coffee-script (~> 2.2) + coffee-script-source (~> 1.11.1) + jekyll-commonmark (1.2.0) + commonmarker (~> 0.14) + jekyll (>= 3.0, < 4.0) + jekyll-commonmark-ghpages (0.1.5) + commonmarker (~> 0.17.6) + jekyll-commonmark (~> 1) + rouge (~> 2) jekyll-default-layout (0.1.4) jekyll (~> 3.0) - jekyll-feed (0.8.0) + jekyll-feed (0.11.0) jekyll (~> 3.3) - jekyll-gist (1.4.0) + jekyll-gist (1.5.0) octokit (~> 4.2) - jekyll-github-metadata (2.2.0) + jekyll-github-metadata (2.9.4) jekyll (~> 3.1) octokit (~> 4.0, != 4.4.0) - jekyll-mentions (1.2.0) - activesupport (~> 4.0) + jekyll-mentions (1.4.1) html-pipeline (~> 2.3) jekyll (~> 3.0) - jekyll-optional-front-matter (0.1.2) + jekyll-optional-front-matter (0.3.0) jekyll (~> 3.0) jekyll-paginate (1.1.0) - jekyll-readme-index (0.0.3) + jekyll-readme-index (0.2.0) jekyll (~> 3.0) - jekyll-redirect-from (0.11.0) - jekyll (>= 2.0) - jekyll-relative-links (0.2.1) + jekyll-redirect-from (0.14.0) jekyll (~> 3.3) - jekyll-sass-converter (1.3.0) - sass (~> 3.2) - jekyll-seo-tag (2.1.0) + jekyll-relative-links (0.5.3) jekyll (~> 3.3) - jekyll-sitemap (0.12.0) + jekyll-remote-theme (0.3.1) + jekyll (~> 3.5) + rubyzip (>= 1.2.1, < 3.0) + jekyll-sass-converter (1.5.2) + sass (~> 3.4) + jekyll-seo-tag (2.5.0) jekyll (~> 3.3) - jekyll-swiss (0.4.0) - jekyll-theme-primer (0.1.1) + jekyll-sitemap (1.2.0) jekyll (~> 3.3) - jekyll-titles-from-headings (0.1.2) + jekyll-swiss (0.4.0) + jekyll-theme-architect (0.1.1) + jekyll (~> 3.5) + jekyll-seo-tag (~> 2.0) + jekyll-theme-cayman (0.1.1) + jekyll (~> 3.5) + jekyll-seo-tag (~> 2.0) + jekyll-theme-dinky (0.1.1) + jekyll (~> 3.5) + jekyll-seo-tag (~> 2.0) + jekyll-theme-hacker (0.1.1) + jekyll (~> 3.5) + jekyll-seo-tag (~> 2.0) + jekyll-theme-leap-day (0.1.1) + jekyll (~> 3.5) + jekyll-seo-tag (~> 2.0) + jekyll-theme-merlot (0.1.1) + jekyll (~> 3.5) + jekyll-seo-tag (~> 2.0) + jekyll-theme-midnight (0.1.1) + jekyll (~> 3.5) + jekyll-seo-tag (~> 2.0) + jekyll-theme-minimal (0.1.1) + jekyll (~> 3.5) + jekyll-seo-tag (~> 2.0) + jekyll-theme-modernist (0.1.1) + jekyll (~> 3.5) + jekyll-seo-tag (~> 2.0) + jekyll-theme-primer (0.5.3) + jekyll (~> 3.5) + jekyll-github-metadata (~> 2.9) + jekyll-seo-tag (~> 2.0) + jekyll-theme-slate (0.1.1) + jekyll (~> 3.5) + jekyll-seo-tag (~> 2.0) + jekyll-theme-tactile (0.1.1) + jekyll (~> 3.5) + jekyll-seo-tag (~> 2.0) + jekyll-theme-time-machine (0.1.1) + jekyll (~> 3.5) + jekyll-seo-tag (~> 2.0) + jekyll-titles-from-headings (0.5.1) jekyll (~> 3.3) - jekyll-watch (1.5.0) - listen (~> 3.0, < 3.1) - jemoji (0.7.0) - activesupport (~> 4.0) - gemoji (~> 2.0) + jekyll-watch (2.1.2) + listen (~> 3.0) + jemoji (0.10.1) + gemoji (~> 3.0) html-pipeline (~> 2.2) - jekyll (>= 3.0) - json (1.8.3) - kramdown (1.11.1) - liquid (3.0.6) - listen (3.0.6) - rb-fsevent (>= 0.9.3) - rb-inotify (>= 0.9.7) + jekyll (~> 3.0) + kramdown (1.17.0) + liquid (4.0.0) + listen (3.1.5) + rb-fsevent (~> 0.9, >= 0.9.4) + rb-inotify (~> 0.9, >= 0.9.7) + ruby_dep (~> 1.2) mercenary (0.3.6) - mini_portile2 (2.1.0) - minima (2.0.0) - minitest (5.10.1) + mini_portile2 (2.4.0) + minima (2.5.0) + jekyll (~> 3.5) + jekyll-feed (~> 0.9) + jekyll-seo-tag (~> 2.1) + minitest (5.11.3) multipart-post (2.0.0) - net-dns (0.8.0) - nokogiri (1.6.8.1-x64-mingw32) - mini_portile2 (~> 2.1.0) - octokit (4.6.2) + nokogiri (1.10.1-x64-mingw32) + mini_portile2 (~> 2.4.0) + octokit (4.13.0) sawyer (~> 0.8.0, >= 0.5.3) - pathutil (0.14.0) + pathutil (0.16.2) forwardable-extended (~> 2.6) - public_suffix (2.0.4) - rb-fsevent (0.9.8) - rb-inotify (0.9.7) - ffi (>= 0.5.0) - rouge (1.11.1) + public_suffix (2.0.5) + rb-fsevent (0.10.3) + rb-inotify (0.10.0) + ffi (~> 1.0) + rouge (2.2.1) + ruby-enum (0.7.2) + i18n + ruby_dep (1.5.0) + rubyzip (1.2.2) safe_yaml (1.0.4) - sass (3.4.22) + sass (3.7.3) + sass-listen (~> 4.0.0) + sass-listen (4.0.0) + rb-fsevent (~> 0.9, >= 0.9.4) + rb-inotify (~> 0.9, >= 0.9.7) sawyer (0.8.1) addressable (>= 2.3.5, < 2.6) faraday (~> 0.8, < 1.0) - terminal-table (1.7.3) - unicode-display_width (~> 1.1.1) - thread_safe (0.3.5) - typhoeus (0.8.0) - ethon (>= 0.8.0) - tzinfo (1.2.2) + terminal-table (1.8.0) + unicode-display_width (~> 1.1, >= 1.1.1) + thread_safe (0.3.6) + typhoeus (1.3.1) + ethon (>= 0.9.0) + tzinfo (1.2.5) thread_safe (~> 0.1) - unicode-display_width (1.1.2) + unicode-display_width (1.4.1) wdm (0.1.1) PLATFORMS x64-mingw32 DEPENDENCIES - github-pages (= 109) + github-pages wdm (~> 0.1.0) BUNDLED WITH - 1.13.6 + 1.16.3 diff --git a/docs/_config.yml b/docs/_config.yml index 5ec9f94d..1b88a813 100644 --- a/docs/_config.yml +++ b/docs/_config.yml @@ -1,12 +1,13 @@ name: VBA-Web -baseurl: "/VBA-Web" +title: VBA-Web +url: https://VBA-tools.github.io/VBA-Web +baseurl: /VBA-Web repository: VBA-tools/VBA-Web -url: http://vba-tools.github.io/VBA-Web/ github_url: https://github.com/VBA-tools/VBA-Web download: https://github.com/VBA-tools/VBA-Web/releases description: "Connect VBA, Excel, Access, and Office for Windows and Mac to web services and the web" -version: 4.1.1 +version: 4.1.6 defaults: - scope: @@ -45,12 +46,14 @@ sass: sass_dir: _css # Default github-pages configuation +encoding: UTF-8 kramdown: input: GFM hard_wrap: false -gems: - - jekyll-coffeescript - - jekyll-paginate +future: true +jailed: false +theme: jekyll-theme-primer +gfm_quirks: paragraph_end # Unchangable github-pages configuration lsi: false @@ -60,3 +63,4 @@ gist: noscript: false kramdown: math_engine: mathjax + syntax_highlighter: rouge diff --git a/docs/_data/docs/WebClient.yml b/docs/_data/docs/WebClient.yml index 82cdb367..2ee46a0a 100644 --- a/docs/_data/docs/WebClient.yml +++ b/docs/_data/docs/WebClient.yml @@ -128,7 +128,7 @@ Methods: Set Response = Client.GetJson(Url) Dim Headers As New Collection - Headers.Add RestHelpers.CreateKeyValue("Authorization", "Bearer ...") + Headers.Add WebHelpers.CreateKeyValue("Authorization", "Bearer ...") Dim Options As New Dictionary Options.Add "Headers", Headers @@ -163,7 +163,7 @@ Methods: Set Response = Client.PostJson(Url, Body) Dim Headers As New Collection - Headers.Add RestHelpers.CreateKeyValue("Authorization", "Bearer ...") + Headers.Add WebHelpers.CreateKeyValue("Authorization", "Bearer ...") Dim Options As New Dictionary Options.Add "Headers", Headers @@ -181,7 +181,7 @@ Methods: description: | Helper for setting proxy values. example: | - Dim Client As New RestClient + Dim Client As New WebClient ' Just Server Client.SetProxy "proxy_server:80" diff --git a/docs/_data/docs/WebRequest.yml b/docs/_data/docs/WebRequest.yml index d3d70881..6b3682b8 100644 --- a/docs/_data/docs/WebRequest.yml +++ b/docs/_data/docs/WebRequest.yml @@ -125,7 +125,7 @@ Properties: (Automatically sets `RequestFormat` to `WebFormat.Custom`) example: | - RestHelpers.RegisterConverter "csv", "text/csv", "Module.ConvertToCSV", "Module.ParseCSV" + WebHelpers.RegisterConverter "csv", "text/csv", "Module.ConvertToCSV", "Module.ParseCSV" Dim Request As New WebRequest Request.CustomRequestFormat = "csv" @@ -142,7 +142,7 @@ Properties: (Automatically sets `ResponseFormat` to `WebFormat.Custom`) example: | - RestHelpers.RegisterConverter "csv", "text/csv", "Module.ConvertToCSV", "Module.ParseCSV" + WebHelpers.RegisterConverter "csv", "text/csv", "Module.ConvertToCSV", "Module.ParseCSV" Dim Request As New WebRequest Request.CustomResponseFormat = "csv" diff --git a/docs/_guides/get.md b/docs/_guides/get.md index b45cdc1d..13e5d507 100644 --- a/docs/_guides/get.md +++ b/docs/_guides/get.md @@ -35,7 +35,7 @@ Public Function GetProject(Id As Long) As Dictionary ' ... ' {"data":{"id":1,"name":"Project 1"}} - If Response.StatusCode = WebStatus.Ok Then + If Response.StatusCode = WebStatusCode.Ok Then ' json response is automatically parsed based Request.Format Set GetProject = Response.Data("data") End If @@ -47,7 +47,7 @@ Public Function GetProject2(Id As Long) As Dictionary Dim Response As WebResponse Set Response = Client.GetJson("projects/" & Id) - If Response.StatusCode = WebStatus.Ok Then + If Response.StatusCode = WebStatusCode.Ok Then Set GetProject2 = Response.Data("data") End If End Function diff --git a/docs/_guides/overview.md b/docs/_guides/overview.md index 5d0f5838..65ef5123 100644 --- a/docs/_guides/overview.md +++ b/docs/_guides/overview.md @@ -48,7 +48,7 @@ Public Function GetProjects() As Collection ' ... ' {"data":[{"id":1,"name":"Project 1"},{"id":2,"name":"Project 2"}]} - If Response.StatusCode <> WebStatus.Ok Then + If Response.StatusCode <> WebStatusCode.Ok Then Err.Raise Response.StatusCode, "GetProjects", Response.Content Else ' Response is automatically converted to Dictionary/Collection by Request.Format diff --git a/docs/_guides/post.md b/docs/_guides/post.md index 6611d9bf..abe9ee30 100644 --- a/docs/_guides/post.md +++ b/docs/_guides/post.md @@ -29,7 +29,7 @@ Public Function CreateProject(Project As Dictionary) As Long ' ... ' {"data":{"id":3,"name":"new Project"}} - If Response.StatusCode <> WebStatus.Created Then + If Response.StatusCode <> WebStatusCode.Created Then Err.Raise Response.StatusCode, "CreateProject", _ "Failed to create project: " & Response.Content Else @@ -37,4 +37,4 @@ Public Function CreateProject(Project As Dictionary) As Long CreateProject = Response.Data("data")("id") End If End Sub -``` \ No newline at end of file +``` diff --git a/examples/VBA-Web - Example.xlsm b/examples/VBA-Web - Example.xlsm index 5caf6e68..7224947c 100644 Binary files a/examples/VBA-Web - Example.xlsm and b/examples/VBA-Web - Example.xlsm differ diff --git a/specs/Credentials.bas b/specs/Credentials.bas index 6e42c48e..9b8481bc 100644 --- a/specs/Credentials.bas +++ b/specs/Credentials.bas @@ -36,9 +36,11 @@ Function Load() As Dictionary Dim Value As String Set pCredentials = New Dictionary + + On Error GoTo ErrorHandling + Open CredentialsPath For Input As #1 - On Error GoTo ErrorHandling Do While Not VBA.EOF(1) Line Input #1, Line Line = VBA.Replace(Line, vbNewLine, "") diff --git a/specs/Specs_WebClient.bas b/specs/Specs_WebClient.bas index 2dc9b7d4..552f5d01 100644 --- a/specs/Specs_WebClient.bas +++ b/specs/Specs_WebClient.bas @@ -331,7 +331,7 @@ Public Function Specs() As SpecSuite Set Request = New WebRequest Request.Resource = "delay/{seconds}" - Request.AddUrlSegment "seconds", "2" + Request.AddUrlSegment "seconds", "5" Set Response = Client.Execute(Request) .Expect(Response.StatusCode).ToEqual 408 diff --git a/specs/Specs_WebHelpers.bas b/specs/Specs_WebHelpers.bas index 11747189..18988108 100644 --- a/specs/Specs_WebHelpers.bas +++ b/specs/Specs_WebHelpers.bas @@ -25,6 +25,7 @@ Public Function Specs() As SpecSuite ' 6. Timing ' 7. Mac ' 8. Cryptography + ' 9. Date/Time conversion ' Errors ' --------------------------------------------- ' @@ -681,6 +682,29 @@ Public Function Specs() As SpecSuite .Expect(Len(WebHelpers.CreateNonce(20))).ToEqual 20 End With + + ' ============================================= ' + ' 9. Date/Time conversion + ' ============================================= ' + + ' ISO to UTC (all ISO dates in daylight saving time) + ' --------------------------------------------- ' + With Specs.It("should handle offset in ISO date") + .Expect(WebHelpers.ConvertToUtc(WebHelpers.ParseIso("2017-05-01T02:00:00.000+02:00"))).ToEqual DateValue("2017-05-01") + TimeValue("00:00:00") ' 02:00:00 in Berlin => 00:00 (same day) UTC + .Expect(WebHelpers.ConvertToUtc(WebHelpers.ParseIso("2017-05-01T00:00:00.000+02:00"))).ToEqual DateValue("2017-04-30") + TimeValue("22:00:00") ' 00:00:00 in Berlin => 22:00 (prev. day) UTC + .Expect(WebHelpers.ConvertToUtc(WebHelpers.ParseIso("2017-04-30T20:00:00.000-04:00"))).ToEqual DateValue("2017-05-01") + TimeValue("00:00:00") ' 20:00:00 in New York => 00:00 (next day) UTC + End With + + ' ISO to UTC + ' --------------------------------------------- ' + With Specs.It("should convert ISO dates in UTC to UTC") + .Expect(WebHelpers.ConvertToUtc(WebHelpers.ParseIso("2017-05-01T00:00:00.000Z"))).ToEqual DateValue("2017-05-01 00:00:00") + TimeValue("00:00:00") + .Expect(WebHelpers.ConvertToUtc(WebHelpers.ParseIso("2017-05-01T00:00:00.000+00:00"))).ToEqual DateValue("2017-05-01 00:00:00") + TimeValue("00:00:00") + End With + + + + ' ============================================= ' ' Errors ' ============================================= ' diff --git a/specs/Specs_WebRequest.bas b/specs/Specs_WebRequest.bas index b993f3d2..2f939ee6 100644 --- a/specs/Specs_WebRequest.bas +++ b/specs/Specs_WebRequest.bas @@ -191,6 +191,22 @@ Public Function Specs() As SpecSuite .Expect(Request.Accept).ToEqual "x-custom/text" End With + ' AcceptEncoding + ' --------------------------------------------- ' + With Specs.It("AcceptEncoding should be set to identity by default") + Set Request = New WebRequest + + .Expect(Request.AcceptEncoding).ToEqual "identity" + End With + + With Specs.It("AcceptEncoding should allow override") + Set Request = New WebRequest + + Request.AcceptEncoding = "gzip" + + .Expect(Request.AcceptEncoding).ToEqual "gzip" + End With + ' ContentLength ' --------------------------------------------- ' With Specs.It("ContentLength should be set from length of Body") @@ -499,17 +515,20 @@ Public Function Specs() As SpecSuite With Specs.It("Prepare should add ContentType, Accept, and ContentLength headers") Set Request = New WebRequest + Request.Method = WebMethod.HttpPost Request.ContentType = "text/plain" Request.Accept = "text/csv" + Request.AcceptEncoding = "gzip" Request.ContentLength = 100 .Expect(Request.Headers.Count).ToEqual 0 Request.Prepare - .Expect(Request.Headers.Count).ToBeGTE 3 + .Expect(Request.Headers.Count).ToBeGTE 4 .Expect(WebHelpers.FindInKeyValues(Request.Headers, "Content-Type")).ToEqual "text/plain" .Expect(WebHelpers.FindInKeyValues(Request.Headers, "Accept")).ToEqual "text/csv" + .Expect(WebHelpers.FindInKeyValues(Request.Headers, "Accept-Encoding")).ToEqual "gzip" .Expect(WebHelpers.FindInKeyValues(Request.Headers, "Content-Length")).ToEqual "100" End With @@ -529,6 +548,25 @@ Public Function Specs() As SpecSuite .Expect(Request.Headers.Count).ToEqual NumHeaders End With + With Specs.It("Prepare should add ContentType headers for GET requests with non-empty body") + Set Request = New WebRequest + + Request.Method = WebMethod.HttpGet + Request.ContentType = "text/plain" + + Request.Prepare + + .Expect(Request.Headers.Count).ToEqual 3 + + Request.Body = "non-empty" + Request.Prepare + + .Expect(Request.Headers.Count).ToEqual 5 + + .Expect(WebHelpers.FindInKeyValues(Request.Headers, "Content-Type")).ToEqual "text/plain" + .Expect(WebHelpers.FindInKeyValues(Request.Headers, "Content-Length")).ToEqual "9" + End With + ' ============================================= ' ' Errors ' ============================================= ' diff --git a/specs/VBA-Web - Specs - Async.xlsm b/specs/VBA-Web - Specs - Async.xlsm index e7cf5612..8f749ccf 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 ba1874bc..67779f75 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 dc78bb35..12587feb 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.1.1 +' IWebAuthenticator v4.1.6 ' (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 4cc58cfa..02122df3 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.1.1 +' WebAsyncWrapper v4.1.6 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' Wrapper WebClient and WebRequest that enables callback-style async requests @@ -223,7 +223,7 @@ Private Sub web_StartTimeoutTimer() End If WebHelpers.AsyncRequests.Add Me.Request.Id, Me - Application.OnTime Now + TimeValue("00:00:" & web_TimeoutS), "'WebHelpers.OnTimeoutTimerExpired """ & Me.Request.Id & """'" + Application.OnTime TimeValue(DateAdd("s", web_TimeoutS, Now)), "'WebHelpers.OnTimeoutTimerExpired """ & Me.Request.Id & """'" End Sub ' Stop timeout timer diff --git a/src/WebClient.cls b/src/WebClient.cls index 4cd0ec12..7136dd86 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.1.1 +' WebClient v4.1.6 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' `WebClient` executes requests and handles response and is responsible for functionality shared between requests, @@ -458,7 +458,7 @@ End Function ' ' @example ' ```VB.net -' Dim Client As New RestClient +' Dim Client As New WebClient ' ' ' Just Server ' Client.SetProxy "proxy_server:80" @@ -642,6 +642,11 @@ Public Function PrepareCurlRequest(Request As WebRequest) As String If Me.FollowRedirects Then web_Curl = web_Curl & " --location" End If + + ' Enable compressed if Accept-Encoding != "identity" + If Request.AcceptEncoding <> "identity" Then + web_Curl = web_Curl & " --compressed" + End If ' Set headers and cookies For Each web_KeyValue In Request.Headers diff --git a/src/WebHelpers.bas b/src/WebHelpers.bas index 32cf44e8..090f9c8e 100644 --- a/src/WebHelpers.bas +++ b/src/WebHelpers.bas @@ -1,6 +1,6 @@ Attribute VB_Name = "WebHelpers" '' -' WebHelpers v4.1.1 +' WebHelpers v4.1.6 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' Contains general-purpose helpers that are used throughout VBA-Web. Includes: @@ -144,10 +144,31 @@ Const AUTOPROXY_DETECT_TYPE_DNS = 2 ' === VBA-UTC Headers #If Mac Then -Private Declare Function utc_popen Lib "libc.dylib" Alias "popen" (ByVal utc_Command As String, ByVal utc_Mode As String) As Long -Private Declare Function utc_pclose Lib "libc.dylib" Alias "pclose" (ByVal utc_File As Long) As Long -Private Declare Function utc_fread Lib "libc.dylib" Alias "fread" (ByVal utc_Buffer As String, ByVal utc_Size As Long, ByVal utc_Number As Long, ByVal utc_File As Long) As Long -Private Declare Function utc_feof Lib "libc.dylib" Alias "feof" (ByVal utc_File As Long) As Long +#If VBA7 Then + +' 64-bit Mac (2016) +Private Declare PtrSafe Function utc_popen Lib "/usr/lib/libc.dylib" Alias "popen" _ + (ByVal utc_Command As String, ByVal utc_Mode As String) As LongPtr +Private Declare PtrSafe Function utc_pclose Lib "/usr/lib/libc.dylib" Alias "pclose" _ + (ByVal utc_File As LongPtr) As LongPtr +Private Declare PtrSafe Function utc_fread Lib "/usr/lib/libc.dylib" Alias "fread" _ + (ByVal utc_Buffer As String, ByVal utc_Size As LongPtr, ByVal utc_Number As LongPtr, ByVal utc_File As LongPtr) As LongPtr +Private Declare PtrSafe Function utc_feof Lib "/usr/lib/libc.dylib" Alias "feof" _ + (ByVal utc_File As LongPtr) As LongPtr + +#Else + +' 32-bit Mac +Private Declare Function utc_popen Lib "libc.dylib" Alias "popen" _ + (ByVal utc_Command As String, ByVal utc_Mode As String) As Long +Private Declare Function utc_pclose Lib "libc.dylib" Alias "pclose" _ + (ByVal utc_File As Long) As Long +Private Declare Function utc_fread Lib "libc.dylib" Alias "fread" _ + (ByVal utc_Buffer As String, ByVal utc_Size As Long, ByVal utc_Number As Long, ByVal utc_File As Long) As Long +Private Declare Function utc_feof Lib "libc.dylib" Alias "feof" _ + (ByVal utc_File As Long) As Long + +#End If #ElseIf VBA7 Then @@ -174,11 +195,21 @@ Private Declare Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alia #If Mac Then +#If VBA7 Then +Private Type utc_ShellResult + utc_Output As String + utc_ExitCode As LongPtr +End Type + +#Else + Private Type utc_ShellResult utc_Output As String utc_ExitCode As Long End Type +#End If + #Else Private Type utc_SYSTEMTIME @@ -205,19 +236,6 @@ End Type #End If ' === End VBA-UTC -#If Mac Then -#ElseIf VBA7 Then - -Private Declare PtrSafe Sub json_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ - (json_MemoryDestination As Any, json_MemorySource As Any, ByVal json_ByteLength As Long) - -#Else - -Private Declare Sub json_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ - (json_MemoryDestination As Any, json_MemorySource As Any, ByVal json_ByteLength As Long) - -#End If - Private Type json_Options ' VBA only stores 15 significant digits, so any numbers larger than that are truncated ' This can lead to issues when BIGINT's are used (e.g. for Ids or Credit Cards), as they will be invalid above 15 digits @@ -237,13 +255,20 @@ Public JsonOptions As json_Options ' === End VBA-JSON #If Mac Then -Private Declare Function web_popen Lib "libc.dylib" Alias "popen" (ByVal Command As String, ByVal mode As String) As Long -Private Declare Function web_pclose Lib "libc.dylib" Alias "pclose" (ByVal File As Long) As Long -Private Declare Function web_fread Lib "libc.dylib" Alias "fread" (ByVal outStr As String, ByVal size As Long, ByVal Items As Long, ByVal stream As Long) As Long -Private Declare Function web_feof Lib "libc.dylib" Alias "feof" (ByVal File As Long) As Long +#If VBA7 Then +Private Declare PtrSafe Function web_popen Lib "/usr/lib/libc.dylib" Alias "popen" (ByVal web_Command As String, ByVal web_Mode As String) As LongPtr +Private Declare PtrSafe Function web_pclose Lib "/usr/lib/libc.dylib" Alias "pclose" (ByVal web_File As LongPtr) As LongPtr +Private Declare PtrSafe Function web_fread Lib "/usr/lib/libc.dylib" Alias "fread" (ByVal web_OutStr As String, ByVal web_Size As LongPtr, ByVal web_Items As LongPtr, ByVal web_Stream As LongPtr) As LongPtr +Private Declare PtrSafe Function web_feof Lib "/usr/lib/libc.dylib" Alias "feof" (ByVal web_File As LongPtr) As LongPtr +#Else +Private Declare Function web_popen Lib "libc.dylib" Alias "popen" (ByVal web_Command As String, ByVal web_Mode As String) As Long +Private Declare Function web_pclose Lib "libc.dylib" Alias "pclose" (ByVal web_File As Long) As Long +Private Declare Function web_fread Lib "libc.dylib" Alias "fread" (ByVal web_OutStr As String, ByVal web_Size As Long, ByVal web_Items As Long, ByVal web_Stream As Long) As Long +Private Declare Function web_feof Lib "libc.dylib" Alias "feof" (ByVal web_File As Long) As Long +#End If #End If -Public Const WebUserAgent As String = "VBA-Web v4.1.1 (https://github.com/VBA-tools/VBA-Web)" +Public Const WebUserAgent As String = "VBA-Web v4.1.6 (https://github.com/VBA-tools/VBA-Web)" ' @internal Public Type ShellResult @@ -1042,7 +1067,7 @@ End Function Public Function Base64Encode(Text As String) As String #If Mac Then Dim web_Command As String - web_Command = "printf " & PrepareTextForShell(Text) & " | openssl base64" + web_Command = "printf " & PrepareTextForPrintf(Text) & " | openssl base64" Base64Encode = ExecuteInShell(web_Command).Output #Else Dim web_Bytes() As Byte @@ -1592,7 +1617,12 @@ End Sub '' Public Function ExecuteInShell(web_Command As String) As ShellResult #If Mac Then +#If VBA7 Then + Dim web_File As LongPtr +#Else Dim web_File As Long +#End If + Dim web_Chunk As String Dim web_Read As Long @@ -1607,16 +1637,18 @@ Public Function ExecuteInShell(web_Command As String) As ShellResult Do While web_feof(web_File) = 0 web_Chunk = VBA.Space$(50) - web_Read = web_fread(web_Chunk, 1, Len(web_Chunk) - 1, web_File) + web_Read = CLng(web_fread(web_Chunk, 1, Len(web_Chunk) - 1, web_File)) If web_Read > 0 Then web_Chunk = VBA.Left$(web_Chunk, web_Read) ExecuteInShell.Output = ExecuteInShell.Output & web_Chunk End If + + VBA.DoEvents Loop web_Cleanup: - ExecuteInShell.ExitCode = web_pclose(web_File) + ExecuteInShell.ExitCode = CLng(web_pclose(web_File)) #End If End Function @@ -1656,6 +1688,43 @@ Public Function PrepareTextForShell(ByVal web_Text As String) As String PrepareTextForShell = web_Text End Function +'' +' Prepare text for using with printf command +' - Wrap in "..." +' - Replace ! with '!' (reserved in bash) +' - Escape \, `, $, and " +' - Replace % with %% (used as an argument marker in printf) +' +' @internal +' @method PrepareTextForPrintf +' @param {String} Text +' @return {String} +'' +Public Function PrepareTextForPrintf(ByVal web_Text As String) As String + ' Escape special characters (except for !) + web_Text = VBA.Replace(web_Text, "\", "\\") + web_Text = VBA.Replace(web_Text, "`", "\`") + web_Text = VBA.Replace(web_Text, "$", "\$") + web_Text = VBA.Replace(web_Text, "%", "%%") + web_Text = VBA.Replace(web_Text, """", "\""") + + ' Wrap in quotes + web_Text = """" & web_Text & """" + + ' Escape ! + web_Text = VBA.Replace(web_Text, "!", """'!'""") + + ' Guard for ! at beginning or end (""'!'"..." or "..."'!'"" -> '!'"..." or "..."'!') + If VBA.Left$(web_Text, 3) = """""'" Then + web_Text = VBA.Right$(web_Text, VBA.Len(web_Text) - 2) + End If + If VBA.Right$(web_Text, 3) = "'""""" Then + web_Text = VBA.Left$(web_Text, VBA.Len(web_Text) - 2) + End If + + PrepareTextForPrintf = web_Text +End Function + ' ============================================= ' ' 8. Cryptography ' ============================================= ' @@ -1681,7 +1750,7 @@ End Function Public Function HMACSHA1(Text As String, Secret As String, Optional Format As String = "Hex") As String #If Mac Then Dim web_Command As String - web_Command = "printf " & PrepareTextForShell(Text) & " | openssl dgst -sha1 -hmac " & PrepareTextForShell(Secret) + web_Command = "printf " & PrepareTextForPrintf(Text) & " | openssl dgst -sha1 -hmac " & PrepareTextForShell(Secret) If Format = "Base64" Then web_Command = web_Command & " -binary | openssl enc -base64" @@ -1728,7 +1797,7 @@ End Function Public Function HMACSHA256(Text As String, Secret As String, Optional Format As String = "Hex") As String #If Mac Then Dim web_Command As String - web_Command = "printf " & PrepareTextForShell(Text) & " | openssl dgst -sha256 -hmac " & PrepareTextForShell(Secret) + web_Command = "printf " & PrepareTextForPrintf(Text) & " | openssl dgst -sha256 -hmac " & PrepareTextForShell(Secret) If Format = "Base64" Then web_Command = web_Command & " -binary | openssl enc -base64" @@ -1777,7 +1846,7 @@ End Function Public Function MD5(Text As String, Optional Format As String = "Hex") As String #If Mac Then Dim web_Command As String - web_Command = "printf " & PrepareTextForShell(Text) & " | openssl dgst -md5" + web_Command = "printf " & PrepareTextForPrintf(Text) & " | openssl dgst -md5" If Format = "Base64" Then web_Command = web_Command & " -binary | openssl enc -base64" @@ -1910,7 +1979,7 @@ Private Function web_GetUrlEncodedKeyValue(Key As Variant, Value As Variant, Opt End Function '' -' VBA-JSON v2.2.2 +' VBA-JSON v2.3.1 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON ' ' JSON Converter for VBA @@ -1996,7 +2065,7 @@ End Function ' @return {String} '' Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitespace As Variant, Optional ByVal json_CurrentIndentation As Long = 0) As String - Dim json_buffer As String + Dim json_Buffer As String Dim json_BufferPosition As Long Dim json_BufferLength As Long Dim json_Index As Long @@ -2057,7 +2126,7 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp End If ' Array - json_BufferAppend json_buffer, "[", json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength On Error Resume Next @@ -2072,21 +2141,21 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp json_IsFirstItem = False Else ' Append comma to previous line - json_BufferAppend json_buffer, ",", json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength End If If json_LBound2D >= 0 And json_UBound2D >= 0 Then ' 2D Array If json_PrettyPrint Then - json_BufferAppend json_buffer, vbNewLine, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength End If - json_BufferAppend json_buffer, json_Indentation & "[", json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, json_Indentation & "[", json_BufferPosition, json_BufferLength For json_Index2D = json_LBound2D To json_UBound2D If json_IsFirstItem2D Then json_IsFirstItem2D = False Else - json_BufferAppend json_buffer, ",", json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength End If json_Converted = ConvertToJson(JsonValue(json_Index, json_Index2D), Whitespace, json_CurrentIndentation + 2) @@ -2103,14 +2172,14 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp json_Converted = vbNewLine & json_InnerIndentation & json_Converted End If - json_BufferAppend json_buffer, json_Converted, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength Next json_Index2D If json_PrettyPrint Then - json_BufferAppend json_buffer, vbNewLine, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength End If - json_BufferAppend json_buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength json_IsFirstItem2D = True Else ' 1D Array @@ -2128,7 +2197,7 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp json_Converted = vbNewLine & json_Indentation & json_Converted End If - json_BufferAppend json_buffer, json_Converted, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength End If Next json_Index End If @@ -2136,7 +2205,7 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp On Error GoTo 0 If json_PrettyPrint Then - json_BufferAppend json_buffer, vbNewLine, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength If VBA.VarType(Whitespace) = VBA.vbString Then json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace) @@ -2145,9 +2214,9 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp End If End If - json_BufferAppend json_buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength - ConvertToJson = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength) + ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition) ' Dictionary or Collection Case VBA.vbObject @@ -2161,7 +2230,7 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp ' Dictionary If VBA.TypeName(JsonValue) = "Dictionary" Then - json_BufferAppend json_buffer, "{", json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, "{", json_BufferPosition, json_BufferLength For Each json_Key In JsonValue.Keys ' For Objects, undefined (Empty/Nothing) is not added to object json_Converted = ConvertToJson(JsonValue(json_Key), Whitespace, json_CurrentIndentation + 1) @@ -2175,7 +2244,7 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp If json_IsFirstItem Then json_IsFirstItem = False Else - json_BufferAppend json_buffer, ",", json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength End If If json_PrettyPrint Then @@ -2184,12 +2253,12 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp json_Converted = """" & json_Key & """:" & json_Converted End If - json_BufferAppend json_buffer, json_Converted, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength End If Next json_Key If json_PrettyPrint Then - json_BufferAppend json_buffer, vbNewLine, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength If VBA.VarType(Whitespace) = VBA.vbString Then json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace) @@ -2198,16 +2267,16 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp End If End If - json_BufferAppend json_buffer, json_Indentation & "}", json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, json_Indentation & "}", json_BufferPosition, json_BufferLength ' Collection ElseIf VBA.TypeName(JsonValue) = "Collection" Then - json_BufferAppend json_buffer, "[", json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength For Each json_Value In JsonValue If json_IsFirstItem Then json_IsFirstItem = False Else - json_BufferAppend json_buffer, ",", json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength End If json_Converted = ConvertToJson(json_Value, Whitespace, json_CurrentIndentation + 1) @@ -2224,11 +2293,11 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp json_Converted = vbNewLine & json_Indentation & json_Converted End If - json_BufferAppend json_buffer, json_Converted, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength Next json_Value If json_PrettyPrint Then - json_BufferAppend json_buffer, vbNewLine, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength If VBA.VarType(Whitespace) = VBA.vbString Then json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace) @@ -2237,10 +2306,10 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp End If End If - json_BufferAppend json_buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength End If - ConvertToJson = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength) + ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition) Case VBA.vbInteger, VBA.vbLong, VBA.vbSingle, VBA.vbDouble, VBA.vbCurrency, VBA.vbDecimal ' Number (use decimals for numbers) ConvertToJson = VBA.Replace(JsonValue, ",", ".") @@ -2344,7 +2413,7 @@ Private Function json_ParseString(json_String As String, ByRef json_Index As Lon Dim json_Quote As String Dim json_Char As String Dim json_Code As String - Dim json_buffer As String + Dim json_Buffer As String Dim json_BufferPosition As Long Dim json_BufferLength As Long @@ -2365,36 +2434,36 @@ Private Function json_ParseString(json_String As String, ByRef json_Index As Lon Select Case json_Char Case """", "\", "/", "'" - json_BufferAppend json_buffer, json_Char, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength json_Index = json_Index + 1 Case "b" - json_BufferAppend json_buffer, vbBack, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, vbBack, json_BufferPosition, json_BufferLength json_Index = json_Index + 1 Case "f" - json_BufferAppend json_buffer, vbFormFeed, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, vbFormFeed, json_BufferPosition, json_BufferLength json_Index = json_Index + 1 Case "n" - json_BufferAppend json_buffer, vbCrLf, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, vbCrLf, json_BufferPosition, json_BufferLength json_Index = json_Index + 1 Case "r" - json_BufferAppend json_buffer, vbCr, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, vbCr, json_BufferPosition, json_BufferLength json_Index = json_Index + 1 Case "t" - json_BufferAppend json_buffer, vbTab, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, vbTab, json_BufferPosition, json_BufferLength json_Index = json_Index + 1 Case "u" ' Unicode character escape (e.g. \u00a9 = Copyright) json_Index = json_Index + 1 json_Code = VBA.Mid$(json_String, json_Index, 4) - json_BufferAppend json_buffer, VBA.ChrW(VBA.Val("&h" + json_Code)), json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, VBA.ChrW(VBA.Val("&h" + json_Code)), json_BufferPosition, json_BufferLength json_Index = json_Index + 4 End Select Case json_Quote - json_ParseString = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength) + json_ParseString = json_BufferToString(json_Buffer, json_BufferPosition) json_Index = json_Index + 1 Exit Function Case Else - json_BufferAppend json_buffer, json_Char, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength json_Index = json_Index + 1 End Select Loop @@ -2480,7 +2549,7 @@ Private Function json_Encode(ByVal json_Text As Variant) As String Dim json_Index As Long Dim json_Char As String Dim json_AscCode As Long - Dim json_buffer As String + Dim json_Buffer As String Dim json_BufferPosition As Long Dim json_BufferLength As Long @@ -2529,10 +2598,10 @@ Private Function json_Encode(ByVal json_Text As Variant) As String json_Char = "\u" & VBA.Right$("0000" & VBA.Hex$(json_AscCode), 4) End Select - json_BufferAppend json_buffer, json_Char, json_BufferPosition, json_BufferLength + json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength Next json_Index - json_Encode = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength) + json_Encode = json_BufferToString(json_Buffer, json_BufferPosition) End Function Private Function json_Peek(json_String As String, ByVal json_Index As Long, Optional json_NumberOfCharacters As Long = 1) As String @@ -2559,7 +2628,6 @@ Private Function json_StringIsLargeNumber(json_String As Variant) As Boolean ' Length with be at least 16 characters and assume will be less than 100 characters If json_Length >= 16 And json_Length <= 100 Then Dim json_CharCode As String - Dim json_Index As Long json_StringIsLargeNumber = True @@ -2605,13 +2673,10 @@ Private Function json_ParseErrorMessage(json_String As String, ByRef json_Index ErrorMessage End Function -Private Sub json_BufferAppend(ByRef json_buffer As String, _ +Private Sub json_BufferAppend(ByRef json_Buffer As String, _ ByRef json_Append As Variant, _ ByRef json_BufferPosition As Long, _ ByRef json_BufferLength As Long) -#If Mac Then - json_buffer = json_buffer & json_Append -#Else ' VBA can be slow to append strings due to allocating a new string for each append ' Instead of using the traditional append, allocate a large empty string and then copy string at append position ' @@ -2625,76 +2690,45 @@ Private Sub json_BufferAppend(ByRef json_buffer As String, _ ' Buffer: "abc " ' Buffer Length: 10 ' - ' Copy memory for "def" into buffer at position 3 (0-based) + ' Put "def" into buffer at position 3 (0-based) ' Buffer: "abcdef " ' ' Approach based on cStringBuilder from vbAccelerator ' http://www.vbaccelerator.com/home/VB/Code/Techniques/RunTime_Debug_Tracing/VB6_Tracer_Utility_zip_cStringBuilder_cls.asp + ' + ' and clsStringAppend from Philip Swannell + ' https://github.com/VBA-tools/VBA-JSON/pull/82 Dim json_AppendLength As Long Dim json_LengthPlusPosition As Long - json_AppendLength = VBA.LenB(json_Append) + json_AppendLength = VBA.Len(json_Append) json_LengthPlusPosition = json_AppendLength + json_BufferPosition If json_LengthPlusPosition > json_BufferLength Then - ' Appending would overflow buffer, add chunks until buffer is long enough - Dim json_TemporaryLength As Long - - json_TemporaryLength = json_BufferLength - Do While json_TemporaryLength < json_LengthPlusPosition - ' Initially, initialize string with 255 characters, - ' then add large chunks (8192) after that - ' - ' Size: # Characters x 2 bytes / character - If json_TemporaryLength = 0 Then - json_TemporaryLength = json_TemporaryLength + 510 - Else - json_TemporaryLength = json_TemporaryLength + 16384 - End If - Loop + ' Appending would overflow buffer, add chunk + ' (double buffer length or append length, whichever is bigger) + Dim json_AddedLength As Long + json_AddedLength = IIf(json_AppendLength > json_BufferLength, json_AppendLength, json_BufferLength) - json_buffer = json_buffer & VBA.Space$((json_TemporaryLength - json_BufferLength) \ 2) - json_BufferLength = json_TemporaryLength + json_Buffer = json_Buffer & VBA.Space$(json_AddedLength) + json_BufferLength = json_BufferLength + json_AddedLength End If - ' Copy memory from append to buffer at buffer position - json_CopyMemory ByVal json_UnsignedAdd(StrPtr(json_buffer), _ - json_BufferPosition), _ - ByVal StrPtr(json_Append), _ - json_AppendLength - + ' Note: Namespacing with VBA.Mid$ doesn't work properly here, throwing compile error: + ' Function call on left-hand side of assignment must return Variant or Object + Mid$(json_Buffer, json_BufferPosition + 1, json_AppendLength) = CStr(json_Append) json_BufferPosition = json_BufferPosition + json_AppendLength -#End If End Sub -Private Function json_BufferToString(ByRef json_buffer As String, ByVal json_BufferPosition As Long, ByVal json_BufferLength As Long) As String -#If Mac Then - json_BufferToString = json_buffer -#Else +Private Function json_BufferToString(ByRef json_Buffer As String, ByVal json_BufferPosition As Long) As String If json_BufferPosition > 0 Then - json_BufferToString = VBA.Left$(json_buffer, json_BufferPosition \ 2) - End If -#End If -End Function - -#If VBA7 Then -Private Function json_UnsignedAdd(json_Start As LongPtr, json_Increment As Long) As LongPtr -#Else -Private Function json_UnsignedAdd(json_Start As Long, json_Increment As Long) As Long -#End If - - If json_Start And &H80000000 Then - json_UnsignedAdd = json_Start + json_Increment - ElseIf (json_Start Or &H80000000) < -json_Increment Then - json_UnsignedAdd = json_Start + json_Increment - Else - json_UnsignedAdd = (json_Start + &H80000000) + (json_Increment + &H80000000) + json_BufferToString = VBA.Left$(json_Buffer, json_BufferPosition) End If End Function '' -' VBA-UTC v1.0.2 +' VBA-UTC v1.0.6 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-UtcConverter ' ' UTC/ISO 8601 Converter for VBA @@ -2842,7 +2876,7 @@ Public Function ParseIso(utc_IsoString As String) As Date ParseIso = ParseUtc(ParseIso) If utc_HasOffset Then - ParseIso = ParseIso + utc_Offset + ParseIso = ParseIso - utc_Offset End If End If @@ -2909,9 +2943,15 @@ Private Function utc_ConvertDate(utc_Value As Date, Optional utc_ConvertToUtc As End Function Private Function utc_ExecuteInShell(utc_ShellCommand As String) As utc_ShellResult +#If VBA7 Then + Dim utc_File As LongPtr + Dim utc_Read As LongPtr +#Else Dim utc_File As Long - Dim utc_Chunk As String Dim utc_Read As Long +#End If + + Dim utc_Chunk As String On Error GoTo utc_ErrorHandling utc_File = utc_popen(utc_ShellCommand, "r") @@ -2920,15 +2960,15 @@ Private Function utc_ExecuteInShell(utc_ShellCommand As String) As utc_ShellResu Do While utc_feof(utc_File) = 0 utc_Chunk = VBA.Space$(50) - utc_Read = utc_fread(utc_Chunk, 1, Len(utc_Chunk) - 1, utc_File) + utc_Read = CLng(utc_fread(utc_Chunk, 1, Len(utc_Chunk) - 1, utc_File)) If utc_Read > 0 Then - utc_Chunk = VBA.Left$(utc_Chunk, utc_Read) + utc_Chunk = VBA.Left$(utc_Chunk, CLng(utc_Read)) utc_ExecuteInShell.utc_Output = utc_ExecuteInShell.utc_Output & utc_Chunk End If Loop utc_ErrorHandling: - utc_ExecuteInShell.utc_ExitCode = utc_pclose(utc_File) + utc_ExecuteInShell.utc_ExitCode = CLng(utc_pclose(utc_File)) End Function #Else diff --git a/src/WebRequest.cls b/src/WebRequest.cls index d7895578..0196eb90 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.1.1 +' WebRequest v4.1.6 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' `WebRequest` is used to create detailed requests @@ -59,6 +59,7 @@ Private web_pBody As Variant Private web_pConvertedBody As Variant Private web_pContentType As String Private web_pAccept As String +Private web_pAcceptEncoding As String Private web_pContentLength As Long Private web_pId As String @@ -413,6 +414,26 @@ Public Property Let Accept(Value As String) web_pAccept = Value End Property +'' +' WinHTTP does not support decompression at this time (Jan. 2019). +' If not Accept-Encoding is passed to the server, [RFC 7231](https://tools.ietf.org/html/rfc7231#section-5.3.4) +' states that "any content-coding is considered acceptable by the user agent" +' -> Explicitly set Accept-Encoding +' +' cURL supports --compressed, which automatically decompresses gzip and other compressed responses +' -> If AcceptEncoding != "identity", enable --compressed flag +'' +Public Property Get AcceptEncoding() As String + If web_pAcceptEncoding <> "" Then + AcceptEncoding = web_pAcceptEncoding + Else + AcceptEncoding = "identity" + End If +End Property +Public Property Let AcceptEncoding(Value As String) + web_pAcceptEncoding = Value +End Property + '' ' Set automatically by length of `Body`, ' but can be overriden to set `Content-Length` header for request. @@ -740,9 +761,12 @@ End Sub Public Sub Prepare() ' Add/replace general headers for request SetHeader "User-Agent", Me.UserAgent - SetHeader "Content-Type", Me.ContentType SetHeader "Accept", Me.Accept - SetHeader "Content-Length", VBA.CStr(Me.ContentLength) + SetHeader "Accept-Encoding", Me.AcceptEncoding + If Me.Method <> WebMethod.HttpGet Or Me.ContentLength > 0 Then + SetHeader "Content-Type", Me.ContentType + SetHeader "Content-Length", VBA.CStr(Me.ContentLength) + End If End Sub '' diff --git a/src/WebResponse.cls b/src/WebResponse.cls index 5c583436..a24a1ce7 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.1.1 +' WebResponse v4.1.6 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' Wrapper for http/cURL responses that includes parsed Data based on WebRequest.ResponseFormat.