Skip to content

Commit 4919976

Browse files
committed
Merge pull request #95 from VBA-tools/remove-ontime
Remove Application.OnTime dependency
2 parents e8fe482 + 5df2c39 commit 4919976

File tree

5 files changed

+136
-100
lines changed

5 files changed

+136
-100
lines changed

src/WebAsyncWrapper.cls

Lines changed: 23 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ Attribute VB_Exposed = True
1313
'
1414
' Wrapper WebClient and WebRequest that enables callback-style async requests
1515
'
16-
' _Note_ Windows-only and requires reference to "Microsoft WinHTTP Services, version 5.1"
16+
' _Note_ Windows-only and Excel-only and requires reference to "Microsoft WinHTTP Services, version 5.1"
1717
'
1818
' Errors:
1919
' 11050 / 80042b2a / -2147210454 - Client should not be changed
@@ -163,11 +163,13 @@ End Sub
163163
''
164164
Public Sub TimedOut()
165165
Dim web_Response As New WebResponse
166+
167+
web_StopTimeoutTimer
168+
WebHelpers.LogDebug "Timed out", "WebAsyncWrapper.TimedOut"
169+
170+
' Callback
166171
web_Response.StatusCode = WebStatusCode.RequestTimeout
167172
web_Response.StatusDescription = "Request Timeout"
168-
169-
' Callback
170-
WebHelpers.LogDebug "Timed out", "WebAsyncWrapper.TimedOut"
171173
web_RunCallback web_Response
172174
End Sub
173175

@@ -210,12 +212,27 @@ End Sub
210212

211213
' Start timeout timer
212214
Private Sub web_StartTimeoutTimer()
213-
WebHelpers.StartTimeoutTimer Me, Me.Client.TimeoutMs
215+
Dim web_TimeoutS As Long
216+
217+
If WebHelpers.AsyncRequests Is Nothing Then: Set WebHelpers.AsyncRequests = New Dictionary
218+
219+
' Round ms to seconds with minimum of 1 second if ms > 0
220+
web_TimeoutS = Round(Me.Client.TimeoutMs / 1000, 0)
221+
If Me.Client.TimeoutMs > 0 And web_TimeoutS = 0 Then
222+
web_TimeoutS = 1
223+
End If
224+
225+
WebHelpers.AsyncRequests.Add Me.Request.Id, Me
226+
Application.OnTime Now + TimeValue("00:00:" & web_TimeoutS), "'WebHelpers.OnTimeoutTimerExpired """ & Me.Request.Id & """'"
214227
End Sub
215228

216229
' Stop timeout timer
217230
Private Sub web_StopTimeoutTimer()
218-
WebHelpers.StopTimeoutTimer Me
231+
If Not WebHelpers.AsyncRequests Is Nothing And Not Me.Request Is Nothing Then
232+
If WebHelpers.AsyncRequests.Exists(Me.Request.Id) Then
233+
WebHelpers.AsyncRequests.Remove Me.Request.Id
234+
End If
235+
End If
219236
End Sub
220237

221238
' Process asynchronous requests

src/WebClient.cls

Lines changed: 23 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,26 @@ Attribute VB_Exposed = True
1111
' WebClient v4.0.3
1212
' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web
1313
'
14-
' Execute requests and handle responses
14+
' `WebClient` executes requests and handles response and is responsible for functionality shared between requests,
15+
' such as authentication, proxy configuration, and security.
16+
'
17+
' Usage:
18+
'
19+
' ```VB.net
20+
' Dim Client As New WebClient
21+
' Client.BaseUrl = "https://www.example.com/api/"
22+
'
23+
' Dim Auth As New HttpBasicAuthenticator
24+
' Auth.Setup Username, Password
25+
' Set Client.Authenticator = Auth
26+
'
27+
' Dim Request As New WebRequest
28+
' Dim Response As WebResponse
29+
' ' Setup WebRequest...
30+
'
31+
' Set Response = Client.Execute(Request)
32+
' ' -> Uses Http Basic authentication and appends Request.Resource to BaseUrl
33+
' ```
1534
'
1635
' Errors:
1736
' 11010 / 80042b02 / -2147210494 - cURL error in Execute
@@ -146,7 +165,7 @@ Public ProxyUsername As String
146165
Public ProxyPassword As String
147166

148167
''
149-
' Load proxy server and bypass list automatically.
168+
' Load proxy server and bypass list automatically (`False` by default).
150169
'
151170
' @property EnableAutoProxy
152171
' @type Boolean
@@ -155,7 +174,8 @@ Public ProxyPassword As String
155174
Public EnableAutoProxy As Boolean
156175

157176
''
158-
' Turn off SSL validation.
177+
' Turn off SSL validation (`False` by default).
178+
' Useful for self-signed certificates and should only be used with trusted servers.
159179
'
160180
' @property Insecure
161181
' @type Boolean

src/WebHelpers.bas

Lines changed: 49 additions & 89 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,17 @@ Attribute VB_Name = "WebHelpers"
33
' WebHelpers v4.0.3
44
' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web
55
'
6-
' Common helpers VBA-Web
6+
' Contains general-purpose helpers that are used throughout VBA-Web. Includes:
7+
'
8+
' - Logging
9+
' - Converters and encoding
10+
' - Url handling
11+
' - Object/Dictionary/Collection/Array helpers
12+
' - Request preparation / handling
13+
' - Timing
14+
' - Mac
15+
' - Cryptography
16+
' - Converters (JSON, XML, Url-Encoded)
717
'
818
' Errors:
919
' 11000 - Error during parsing
@@ -213,11 +223,10 @@ End Type
213223

214224
Private web_pDocumentHelper As Object
215225
Private web_pElHelper As Object
216-
Private web_pAsyncRequests As Dictionary
217226
Private web_pConverters As Dictionary
218227

219228
' --------------------------------------------- '
220-
' Types
229+
' Types and Properties
221230
' --------------------------------------------- '
222231

223232
''
@@ -308,7 +317,26 @@ End Enum
308317
'
309318
' @example
310319
' ```VB.net
320+
' Dim Client As New WebClient
321+
' Client.BaseUrl = "https://api.example.com/v1/"
311322
'
323+
' Dim RequestWithTypo As New WebRequest
324+
' RequestWithTypo.Resource = "peeple/{id}"
325+
' RequestWithType.AddUrlSegment "idd", 123
326+
'
327+
' ' Enable logging before the request is executed
328+
' WebHelpers.EnableLogging = True
329+
'
330+
' Dim Response As WebResponse
331+
' Set Response = Client.Execute(Request)
332+
'
333+
' ' Immediate window:
334+
' ' --> Request - (Time)
335+
' ' GET https://api.example.com/v1/peeple/{id}
336+
' ' Headers...
337+
' '
338+
' ' <-- Response - (Time)
339+
' ' 404 ...
312340
' ```
313341
'
314342
' @property EnableLogging
@@ -317,6 +345,14 @@ End Enum
317345
''
318346
Public EnableLogging As Boolean
319347

348+
''
349+
' Store currently running async requests
350+
'
351+
' @property AsyncRequests
352+
' @type Dictionary
353+
''
354+
Public AsyncRequests As Dictionary
355+
320356
' ============================================= '
321357
' 1. Logging
322358
' ============================================= '
@@ -489,15 +525,15 @@ End Function
489525
'
490526
' @method ParseJson
491527
' @param {String} Json JSON value to parse
492-
' @return {Object}
528+
' @return {Dictionary|Collection}
493529
'
494530
' (Implemented in VBA-JSON embedded below)
495531

496532
'
497533
' Convert `Dictionary`, `Collection`, or `Array` to JSON string.
498534
'
499535
' @method ConvertToJson
500-
' @param {Dictionary|Collection|Variant} Obj
536+
' @param {Dictionary|Collection|Array} Obj
501537
' @return {String}
502538
'
503539
' (Implemented in VBA-JSON embedded below)
@@ -1220,7 +1256,7 @@ End Function
12201256
'
12211257
' @method FindInKeyValues
12221258
' @param {Collection} KeyValues
1223-
' @param {String} Key to find
1259+
' @param {Variant} Key to find
12241260
' @return {Variant}
12251261
''
12261262
Public Function FindInKeyValues(KeyValues As Collection, Key As Variant) As Variant
@@ -1259,7 +1295,7 @@ End Function
12591295
'
12601296
' @method AddOrReplaceInKeyValues
12611297
' @param {Collection} KeyValues
1262-
' @param {String} Key
1298+
' @param {Variant} Key
12631299
' @param {Variant} Value
12641300
' @return {Variant}
12651301
''
@@ -1348,84 +1384,10 @@ Public Function MethodToName(Method As WebMethod) As String
13481384
End Select
13491385
End Function
13501386

1351-
''
1352-
' Add request to watched requests
1353-
'
1354-
' @internal
1355-
' @method AddAsyncRequest
1356-
' @param {RestAsyncWrapper} AsyncWrapper
1357-
''
1358-
Public Sub AddAsyncRequest(web_AsyncWrapper As Object)
1359-
If web_pAsyncRequests Is Nothing Then: Set web_pAsyncRequests = New Dictionary
1360-
If Not web_AsyncWrapper.Request Is Nothing Then
1361-
web_pAsyncRequests.Add web_AsyncWrapper.Request.Id, web_AsyncWrapper
1362-
End If
1363-
End Sub
1364-
1365-
''
1366-
' Get watched request
1367-
'
1368-
' @internal
1369-
' @method GetAsyncRequest
1370-
' @param {String} RequestId
1371-
' @return {RestAsyncWrapper}
1372-
''
1373-
Public Function GetAsyncRequest(web_RequestId As String) As Object
1374-
If web_pAsyncRequests.Exists(web_RequestId) Then
1375-
Set GetAsyncRequest = web_pAsyncRequests(web_RequestId)
1376-
End If
1377-
End Function
1378-
1379-
''
1380-
' Remove request from watched requests
1381-
'
1382-
' @internal
1383-
' @method RemoveAsyncRequest
1384-
' @param {String} RequestId
1385-
''
1386-
Public Sub RemoveAsyncRequest(web_RequestId As String)
1387-
If Not web_pAsyncRequests Is Nothing Then
1388-
If web_pAsyncRequests.Exists(web_RequestId) Then: web_pAsyncRequests.Remove web_RequestId
1389-
End If
1390-
End Sub
1391-
13921387
' ============================================= '
13931388
' 6. Timing
13941389
' ============================================= '
13951390

1396-
''
1397-
' Start timeout timer for request
1398-
'
1399-
' @internal
1400-
' @method StartTimeoutTimer
1401-
' @param {RestAsyncWrapper} AsyncWrapper
1402-
' @param {Long} TimeoutMS
1403-
''
1404-
Public Sub StartTimeoutTimer(web_AsyncWrapper As Object, web_TimeoutMs As Long)
1405-
' Round ms to seconds with minimum of 1 second if ms > 0
1406-
Dim web_TimeoutS As Long
1407-
web_TimeoutS = Round(web_TimeoutMs / 1000, 0)
1408-
If web_TimeoutMs > 0 And web_TimeoutS = 0 Then
1409-
web_TimeoutS = 1
1410-
End If
1411-
1412-
AddAsyncRequest web_AsyncWrapper
1413-
Application.OnTime Now + TimeValue("00:00:" & web_TimeoutS), "'WebHelpers.OnTimeoutTimerExpired """ & web_AsyncWrapper.Request.Id & """'"
1414-
End Sub
1415-
1416-
''
1417-
' Stop timeout timer for request
1418-
'
1419-
' @internal
1420-
' @method StopTimeoutTimer
1421-
' @param {RestAsyncWrapper} AsyncWrapper
1422-
''
1423-
Public Sub StopTimeoutTimer(web_AsyncWrapper As Object)
1424-
If Not web_AsyncWrapper.Request Is Nothing Then
1425-
RemoveAsyncRequest web_AsyncWrapper.Request.Id
1426-
End If
1427-
End Sub
1428-
14291391
''
14301392
' Handle timeout timers expiring
14311393
'
@@ -1434,14 +1396,12 @@ End Sub
14341396
' @param {String} RequestId
14351397
''
14361398
Public Sub OnTimeoutTimerExpired(web_RequestId As String)
1437-
Dim web_AsyncWrapper As Object
1438-
Set web_AsyncWrapper = GetAsyncRequest(web_RequestId)
1439-
1440-
If Not web_AsyncWrapper Is Nothing Then
1441-
StopTimeoutTimer web_AsyncWrapper
1442-
1443-
LogDebug "Async Timeout: " & web_AsyncWrapper.Request.FormattedResource, "WebHelpers.OnTimeoutTimerExpired"
1444-
web_AsyncWrapper.TimedOut
1399+
If Not AsyncRequests Is Nothing Then
1400+
If AsyncRequests.Exists(web_RequestId) Then
1401+
Dim web_AsyncWrapper As Object
1402+
Set web_AsyncWrapper = AsyncRequests(web_RequestId)
1403+
web_AsyncWrapper.TimedOut
1404+
End If
14451405
End If
14461406
End Sub
14471407

src/WebRequest.cls

Lines changed: 26 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,32 @@ Attribute VB_Exposed = True
1111
' WebRequest v4.0.3
1212
' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web
1313
'
14-
' Create a request for use with a WebClient
14+
' `WebRequest` is used to create detailed requests
15+
' (including formatting, querystrings, headers, cookies, and much more).
16+
'
17+
' Usage:
18+
' ```VB.net
19+
' Dim Request As New WebRequest
20+
' Request.Resource = "users/{Id}"
21+
'
22+
' Request.Method = WebMethod.HttpPut
23+
' Request.RequestFormat = WebFormat.UrlEncoded
24+
' Request.ResponseFormat = WebFormat.Json
25+
'
26+
' Dim Body As New Dictionary
27+
' Body.Add "name", "Tim"
28+
' Body.Add "project", "VBA-Web"
29+
' Set Request.Body = Body
30+
'
31+
' Request.AddUrlSegment "Id", 123
32+
' Request.AddQuerystringParam "api_key", "abcd"
33+
' Request.AddHeader "Authorization", "Token ..."
34+
'
35+
' ' -> PUT (Client.BaseUrl)users/123?api_key=abcd
36+
' ' Authorization: Token ...
37+
' '
38+
' ' name=Tim&project=VBA-Web
39+
' ```
1540
'
1641
' Errors:
1742
' 11020 / 80042b0c / -2147210484 - Cannot add body parameter to non-Dictionary

src/WebResponse.cls

Lines changed: 15 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,21 @@ Attribute VB_Exposed = True
1111
' WebResponse v4.0.3
1212
' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web
1313
'
14-
' Wrapper for http/cURL responses
14+
' Wrapper for http/cURL responses that includes parsed Data based on WebRequest.ResponseFormat.
15+
'
16+
' Usage:
17+
' ```VB.net
18+
' Dim Response As WebResponse
19+
' Set Response = Client.Execute(Request)
20+
'
21+
' If Response.StatusCode = WebStatusCode.Ok Then
22+
' ' Response.Headers, Response.Cookies
23+
' ' Response.Data -> Parsed Response.Content based on Request.ResponseFormat
24+
' ' Response.Body -> Raw response bytes
25+
' Else
26+
' Debug.Print "Error: " & Response.StatusCode & " - " & Response.Content
27+
' End If
28+
' ```
1529
'
1630
' Errors:
1731
' 11030 / 80042b16 / -2147210474 - Error creating from http

0 commit comments

Comments
 (0)