Skip to content

Remove Application.OnTime dependency #95

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Feb 9, 2015
Merged

Remove Application.OnTime dependency #95

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
46f8b86
Refactor timing
timhall Feb 8, 2015
a9f814b
Merge branch 'master' into remove-ontime
timhall Feb 9, 2015
5df2c39
Add Excel-only disclaimer to WebAsyncWrapper
timhall Feb 9, 2015
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
29 changes: 23 additions & 6 deletions src/WebAsyncWrapper.cls
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ Attribute VB_Exposed = True
'
' Wrapper WebClient and WebRequest that enables callback-style async requests
'
' _Note_ Windows-only and requires reference to "Microsoft WinHTTP Services, version 5.1"
' _Note_ Windows-only and Excel-only and requires reference to "Microsoft WinHTTP Services, version 5.1"
'
' Errors:
' 11050 / 80042b2a / -2147210454 - Client should not be changed
Expand Down Expand Up @@ -163,11 +163,13 @@ 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"

' Callback
WebHelpers.LogDebug "Timed out", "WebAsyncWrapper.TimedOut"
web_RunCallback web_Response
End Sub

Expand Down Expand Up @@ -210,12 +212,27 @@ End Sub

' Start timeout timer
Private Sub web_StartTimeoutTimer()
WebHelpers.StartTimeoutTimer Me, Me.Client.TimeoutMs
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

' Stop timeout timer
Private Sub web_StopTimeoutTimer()
WebHelpers.StopTimeoutTimer Me
If Not WebHelpers.AsyncRequests Is Nothing And Not Me.Request Is Nothing Then
If WebHelpers.AsyncRequests.Exists(Me.Request.Id) Then
WebHelpers.AsyncRequests.Remove Me.Request.Id
End If
End If
End Sub

' Process asynchronous requests
Expand Down
26 changes: 23 additions & 3 deletions src/WebClient.cls
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,26 @@ Attribute VB_Exposed = True
' WebClient v4.0.3
' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web
'
' Execute requests and handle responses
' `WebClient` executes requests and handles response and is responsible for functionality shared between requests,
' such as authentication, proxy configuration, and security.
'
' Usage:
'
' ```VB.net
' Dim Client As New WebClient
' Client.BaseUrl = "https://www.example.com/api/"
'
' Dim Auth As New HttpBasicAuthenticator
' Auth.Setup Username, Password
' Set Client.Authenticator = Auth
'
' Dim Request As New WebRequest
' Dim Response As WebResponse
' ' Setup WebRequest...
'
' Set Response = Client.Execute(Request)
' ' -> Uses Http Basic authentication and appends Request.Resource to BaseUrl
' ```
'
' Errors:
' 11010 / 80042b02 / -2147210494 - cURL error in Execute
Expand Down Expand Up @@ -146,7 +165,7 @@ Public ProxyUsername As String
Public ProxyPassword As String

''
' Load proxy server and bypass list automatically.
' Load proxy server and bypass list automatically (`False` by default).
'
' @property EnableAutoProxy
' @type Boolean
Expand All @@ -155,7 +174,8 @@ Public ProxyPassword As String
Public EnableAutoProxy As Boolean

''
' Turn off SSL validation.
' Turn off SSL validation (`False` by default).
' Useful for self-signed certificates and should only be used with trusted servers.
'
' @property Insecure
' @type Boolean
Expand Down
138 changes: 49 additions & 89 deletions src/WebHelpers.bas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,17 @@ Attribute VB_Name = "WebHelpers"
' WebHelpers v4.0.3
' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web
'
' Common helpers VBA-Web
' Contains general-purpose helpers that are used throughout VBA-Web. Includes:
'
' - Logging
' - Converters and encoding
' - Url handling
' - Object/Dictionary/Collection/Array helpers
' - Request preparation / handling
' - Timing
' - Mac
' - Cryptography
' - Converters (JSON, XML, Url-Encoded)
'
' Errors:
' 11000 - Error during parsing
Expand Down Expand Up @@ -213,11 +223,10 @@ End Type

Private web_pDocumentHelper As Object
Private web_pElHelper As Object
Private web_pAsyncRequests As Dictionary
Private web_pConverters As Dictionary

' --------------------------------------------- '
' Types
' Types and Properties
' --------------------------------------------- '

''
Expand Down Expand Up @@ -308,7 +317,26 @@ End Enum
'
' @example
' ```VB.net
' Dim Client As New WebClient
' Client.BaseUrl = "https://api.example.com/v1/"
'
' Dim RequestWithTypo As New WebRequest
' RequestWithTypo.Resource = "peeple/{id}"
' RequestWithType.AddUrlSegment "idd", 123
'
' ' Enable logging before the request is executed
' WebHelpers.EnableLogging = True
'
' Dim Response As WebResponse
' Set Response = Client.Execute(Request)
'
' ' Immediate window:
' ' --> Request - (Time)
' ' GET https://api.example.com/v1/peeple/{id}
' ' Headers...
' '
' ' <-- Response - (Time)
' ' 404 ...
' ```
'
' @property EnableLogging
Expand All @@ -317,6 +345,14 @@ End Enum
''
Public EnableLogging As Boolean

''
' Store currently running async requests
'
' @property AsyncRequests
' @type Dictionary
''
Public AsyncRequests As Dictionary

' ============================================= '
' 1. Logging
' ============================================= '
Expand Down Expand Up @@ -489,15 +525,15 @@ End Function
'
' @method ParseJson
' @param {String} Json JSON value to parse
' @return {Object}
' @return {Dictionary|Collection}
'
' (Implemented in VBA-JSON embedded below)

'
' Convert `Dictionary`, `Collection`, or `Array` to JSON string.
'
' @method ConvertToJson
' @param {Dictionary|Collection|Variant} Obj
' @param {Dictionary|Collection|Array} Obj
' @return {String}
'
' (Implemented in VBA-JSON embedded below)
Expand Down Expand Up @@ -1220,7 +1256,7 @@ End Function
'
' @method FindInKeyValues
' @param {Collection} KeyValues
' @param {String} Key to find
' @param {Variant} Key to find
' @return {Variant}
''
Public Function FindInKeyValues(KeyValues As Collection, Key As Variant) As Variant
Expand Down Expand Up @@ -1259,7 +1295,7 @@ End Function
'
' @method AddOrReplaceInKeyValues
' @param {Collection} KeyValues
' @param {String} Key
' @param {Variant} Key
' @param {Variant} Value
' @return {Variant}
''
Expand Down Expand Up @@ -1348,84 +1384,10 @@ Public Function MethodToName(Method As WebMethod) As String
End Select
End Function

''
' Add request to watched requests
'
' @internal
' @method AddAsyncRequest
' @param {RestAsyncWrapper} AsyncWrapper
''
Public Sub AddAsyncRequest(web_AsyncWrapper As Object)
If web_pAsyncRequests Is Nothing Then: Set web_pAsyncRequests = New Dictionary
If Not web_AsyncWrapper.Request Is Nothing Then
web_pAsyncRequests.Add web_AsyncWrapper.Request.Id, web_AsyncWrapper
End If
End Sub

''
' Get watched request
'
' @internal
' @method GetAsyncRequest
' @param {String} RequestId
' @return {RestAsyncWrapper}
''
Public Function GetAsyncRequest(web_RequestId As String) As Object
If web_pAsyncRequests.Exists(web_RequestId) Then
Set GetAsyncRequest = web_pAsyncRequests(web_RequestId)
End If
End Function

''
' Remove request from watched requests
'
' @internal
' @method RemoveAsyncRequest
' @param {String} RequestId
''
Public Sub RemoveAsyncRequest(web_RequestId As String)
If Not web_pAsyncRequests Is Nothing Then
If web_pAsyncRequests.Exists(web_RequestId) Then: web_pAsyncRequests.Remove web_RequestId
End If
End Sub

' ============================================= '
' 6. Timing
' ============================================= '

''
' Start timeout timer for request
'
' @internal
' @method StartTimeoutTimer
' @param {RestAsyncWrapper} AsyncWrapper
' @param {Long} TimeoutMS
''
Public Sub StartTimeoutTimer(web_AsyncWrapper As Object, web_TimeoutMs As Long)
' Round ms to seconds with minimum of 1 second if ms > 0
Dim web_TimeoutS As Long
web_TimeoutS = Round(web_TimeoutMs / 1000, 0)
If web_TimeoutMs > 0 And web_TimeoutS = 0 Then
web_TimeoutS = 1
End If

AddAsyncRequest web_AsyncWrapper
Application.OnTime Now + TimeValue("00:00:" & web_TimeoutS), "'WebHelpers.OnTimeoutTimerExpired """ & web_AsyncWrapper.Request.Id & """'"
End Sub

''
' Stop timeout timer for request
'
' @internal
' @method StopTimeoutTimer
' @param {RestAsyncWrapper} AsyncWrapper
''
Public Sub StopTimeoutTimer(web_AsyncWrapper As Object)
If Not web_AsyncWrapper.Request Is Nothing Then
RemoveAsyncRequest web_AsyncWrapper.Request.Id
End If
End Sub

''
' Handle timeout timers expiring
'
Expand All @@ -1434,14 +1396,12 @@ End Sub
' @param {String} RequestId
''
Public Sub OnTimeoutTimerExpired(web_RequestId As String)
Dim web_AsyncWrapper As Object
Set web_AsyncWrapper = GetAsyncRequest(web_RequestId)

If Not web_AsyncWrapper Is Nothing Then
StopTimeoutTimer web_AsyncWrapper

LogDebug "Async Timeout: " & web_AsyncWrapper.Request.FormattedResource, "WebHelpers.OnTimeoutTimerExpired"
web_AsyncWrapper.TimedOut
If Not AsyncRequests Is Nothing Then
If AsyncRequests.Exists(web_RequestId) Then
Dim web_AsyncWrapper As Object
Set web_AsyncWrapper = AsyncRequests(web_RequestId)
web_AsyncWrapper.TimedOut
End If
End If
End Sub

Expand Down
27 changes: 26 additions & 1 deletion src/WebRequest.cls
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,32 @@ Attribute VB_Exposed = True
' WebRequest v4.0.3
' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web
'
' Create a request for use with a WebClient
' `WebRequest` is used to create detailed requests
' (including formatting, querystrings, headers, cookies, and much more).
'
' Usage:
' ```VB.net
' Dim Request As New WebRequest
' Request.Resource = "users/{Id}"
'
' Request.Method = WebMethod.HttpPut
' Request.RequestFormat = WebFormat.UrlEncoded
' Request.ResponseFormat = WebFormat.Json
'
' Dim Body As New Dictionary
' Body.Add "name", "Tim"
' Body.Add "project", "VBA-Web"
' Set Request.Body = Body
'
' Request.AddUrlSegment "Id", 123
' Request.AddQuerystringParam "api_key", "abcd"
' Request.AddHeader "Authorization", "Token ..."
'
' ' -> PUT (Client.BaseUrl)users/123?api_key=abcd
' ' Authorization: Token ...
' '
' ' name=Tim&project=VBA-Web
' ```
'
' Errors:
' 11020 / 80042b0c / -2147210484 - Cannot add body parameter to non-Dictionary
Expand Down
16 changes: 15 additions & 1 deletion src/WebResponse.cls
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,21 @@ Attribute VB_Exposed = True
' WebResponse v4.0.3
' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web
'
' Wrapper for http/cURL responses
' Wrapper for http/cURL responses that includes parsed Data based on WebRequest.ResponseFormat.
'
' Usage:
' ```VB.net
' Dim Response As WebResponse
' Set Response = Client.Execute(Request)
'
' If Response.StatusCode = WebStatusCode.Ok Then
' ' Response.Headers, Response.Cookies
' ' Response.Data -> Parsed Response.Content based on Request.ResponseFormat
' ' Response.Body -> Raw response bytes
' Else
' Debug.Print "Error: " & Response.StatusCode & " - " & Response.Content
' End If
' ```
'
' Errors:
' 11030 / 80042b16 / -2147210474 - Error creating from http
Expand Down