Skip to content

Commit b1aad8e

Browse files
Sophist-UKSophist-UK
committed
New Windows-only Class WebAsyncClient
This is an alternative way of submitting asynchronous Web calls to WenAsyncWrapper. The WebClientAsync class truly wraps the WebClient class, providing the same methods and properties and passing them through to WebClient. It is inspired by WebAsyncWrapper and tries to make async calls as compatible as possible with WebClient. It also provides an ExecuteAsync method that kicks off a web call (using another WebClientAsyncInstance class) and passes results or errors back to the caller using Events. Like WebAsyncWrapper it relies on WinHttpRequest and so is Windows only (or at least until someone writes a WebHttpRequest compatible class for Mac like Tim has done with the Dictionary class). Because it returns results using Events, it can only be called from another Class module, however it is the authors belief that anyone doing Async calls is likely to be using classes anyway. Having written and undertaken some simple tests, I am submitting this code for early review. Once I have written the real code that will use it and ironed out any bugs found, and rounded out the comments I will let you know it is ready for merging.
1 parent 918536d commit b1aad8e

File tree

2 files changed

+536
-0
lines changed

2 files changed

+536
-0
lines changed

‎src/WebClientAsync.cls

+385
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,385 @@
1+
VERSION 1.0 CLASS
2+
BEGIN
3+
MultiUse = -1 'True
4+
END
5+
Attribute VB_Name = "WebClientAsync"
6+
Attribute VB_GlobalNameSpace = False
7+
Attribute VB_Creatable = False
8+
Attribute VB_PredeclaredId = False
9+
Attribute VB_Exposed = False
10+
''
11+
' WebClientAsync v4.0.21
12+
' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web
13+
'
14+
' `WebClientAsync` is a an asynchronous wrapper for the WebClient class,
15+
' providing a more intuitive way of running asynchronous requests than using
16+
' WebAsyncWrapper, and delivering results and errors back through VBA Events.
17+
'
18+
' _Note_ Windows-only and requires reference to "Microsoft WinHTTP Services, version 5.1"
19+
'
20+
' Usage:
21+
'
22+
' ```VBA
23+
' Dim WithEvents Client As New WebClientAsync
24+
' Client.BaseUrl = "https://www.example.com/api/"
25+
'
26+
' Dim Auth As New HttpBasicAuthenticator
27+
' Auth.Setup Username, Password
28+
' Set Client.Authenticator = Auth
29+
'
30+
' Dim Request As New WebRequest
31+
' Dim Response As WebResponse
32+
' ' Setup WebRequest...
33+
'
34+
' Client.ExecuteAsync(Request, uniqueArgs)
35+
' ' -> Uses Http Basic authentication and appends Request.Resource to BaseUrl
36+
'
37+
' Private Sub Client_AsyncResponse(Response as WebResponse, uniqueArgs)
38+
' ' Process response here
39+
' End Sub
40+
'
41+
' Private Sub Client_AsyncError(Response as WebResponse, uniqueArgs)
42+
' ' Handle response here
43+
' End Sub
44+
' ```
45+
'
46+
' Errors:
47+
' 11010 / 80042b02 / -2147210494 - cURL error in Execute
48+
' 11011 / 80042b03 / -2147210493 - Error in Execute
49+
' 11012 / 80042b04 / -2147210492 - Error preparing http request
50+
' 11080 - Active async requests must have unique RequestRef
51+
' 11081 - Unable to find request to abort
52+
'
53+
' @class WebClientAsync
54+
' @author Paul Freeman <[email protected]>
55+
' @license MIT (http://www.opensource.org/licenses/mit-license.php)
56+
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
57+
58+
Option Explicit
59+
' This is a Windows only module - so leave as blank class if Mac
60+
#If Not Mac Then
61+
62+
' ============================================= '
63+
' Global Class Declarations
64+
' ============================================= '
65+
66+
' --------------------------------------------- '
67+
' Module constants
68+
' --------------------------------------------- '
69+
Private Const DefaultMaxAsyncRequests As Integer = 8
70+
71+
' --------------------------------------------- '
72+
' Windows Kernel timing functions
73+
' --------------------------------------------- '
74+
75+
#If VBA7 Then
76+
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
77+
Private Declare PtrSafe Function getFrequency Lib "kernel32" () As Long
78+
#Else
79+
Private Declare Function GetTickCount Lib "kernel32" () As Long
80+
Private Declare Function getFrequency Lib "kernel32" () As Long
81+
#End If
82+
83+
' --------------------------------------------- '
84+
' Public Class Variables
85+
' --------------------------------------------- '
86+
87+
''
88+
' Request that is currently executing.
89+
'
90+
' @property Request
91+
' @type WebRequest
92+
''
93+
Public Request As WebRequest
94+
Public MaxAsyncRequests As Integer
95+
96+
' --------------------------------------------- '
97+
' Events created
98+
' --------------------------------------------- '
99+
100+
Event AsyncResponse(ByVal Response As WebResponse, ByVal RequestRef As Variant)
101+
Event AsyncError(ByVal ErrorNumber As Long, ByVal errorDescription As String, ByVal RequestRef As Variant)
102+
103+
' --------------------------------------------- '
104+
' Constants and Private Variables
105+
' --------------------------------------------- '
106+
107+
Private Client As WebClient
108+
Private ActiveRequests As Collection
109+
Private QueuedRequests As Collection
110+
Private WithEvents WCAI As WebClientAsyncInstance
111+
Attribute WCAI.VB_VarHelpID = -1
112+
Private newWCAI As WebClientAsyncInstance
113+
' ============================================= '
114+
' Code
115+
' ============================================= '
116+
' --------------------------------------------- '
117+
' Class Initialisation / Termination
118+
' --------------------------------------------- '
119+
Private Sub Class_Initialize()
120+
WebHelpers.LogDebug "Initializing", "WebClientAsync.Class_Initialize"
121+
122+
Set ActiveRequests = New Collection
123+
124+
Set QueuedRequests = New Collection
125+
Set Client = New WebClient
126+
' WCAI is a Delegate object which is called to raise events
127+
Set WCAI = New WebClientAsyncInstance
128+
' We create a newWCAI instance in advance in order to
129+
' avoid delay to instantiate the class before issuing the web request
130+
Set newWCAI = New WebClientAsyncInstance
131+
Set newWCAI.Delegate = WCAI
132+
MaxAsyncRequests = DefaultMaxAsyncRequests
133+
End Sub
134+
Private Sub Class_Terminate()
135+
WebHelpers.LogDebug "Terminating", "WebClientAsync.Class_Terminate"
136+
137+
Dim instance As WebClientAsyncInstance
138+
For Each instance In ActiveRequests
139+
WebHelpers.LogDebug "Aborting WebClientAsyncInstance: " & instance.nonce, "WebClientAsync.Abort"
140+
instance.Abort "WebClientAsync terminating"
141+
ActiveRequests.Remove instance.nonce
142+
Next instance
143+
Set ActiveRequests = Nothing
144+
Set Client = Nothing
145+
End Sub
146+
147+
' --------------------------------------------- '
148+
' Public Methods - Extending WebClient
149+
' --------------------------------------------- '
150+
Public Sub ExecuteAsync( _
151+
ByVal Request As WebRequest, _
152+
Optional ByVal RequestRef As Variant, _
153+
Optional ByVal Priority As Boolean _
154+
)
155+
WebHelpers.LogDebug "Called", "WebClientAsync.ExecuteAsync"
156+
157+
Dim errMsg As String
158+
Dim nonce As String
159+
Dim instance As WebClientAsyncInstance
160+
161+
' RequestRef must be unique
162+
For Each instance In ActiveRequests
163+
If RequestRef = instance.RequestRef Then GoTo DuplicateReqArgs
164+
Next instance
165+
For Each instance In QueuedRequests
166+
If RequestRef = instance.RequestRef Then GoTo DuplicateReqArgs
167+
Next instance
168+
169+
nonce = WebHelpers.CreateNonce
170+
newWCAI.nonce = nonce
171+
Set newWCAI.Request = Request.Clone
172+
Set newWCAI.Client = Client
173+
If IsObject(RequestRef) Then
174+
Set newWCAI.RequestRef = RequestRef
175+
Else
176+
newWCAI.RequestRef = RequestRef
177+
End If
178+
If Priority Then
179+
QueuedRequests.Add Item:=newWCAI, Key:=nonce, Before:=1
180+
Else
181+
QueuedRequests.Add Item:=newWCAI, Key:=nonce
182+
End If
183+
Call ExecuteQueuedRequests
184+
Set newWCAI = New WebClientAsyncInstance
185+
Set newWCAI.Delegate = WCAI
186+
Exit Sub
187+
188+
DuplicateReqArgs:
189+
Dim errorDescription As String
190+
191+
errorDescription = "Active async requests must have unique RequestRef"
192+
WebHelpers.LogError errorDescription, "WebClientAsync.ExecuteAsync", 11080
193+
Err.Raise 11080 + vbObjectError, "WebClientAsync.ExecuteAsync", errorDescription
194+
195+
End Sub
196+
Public Sub Abort(Optional ByVal Reason As String = "", Optional ByVal RequestRef As Variant)
197+
WebHelpers.LogDebug "Called", "WebClientAsync.Abort"
198+
199+
Dim instance As WebClientAsyncInstance
200+
For Each instance In ActiveRequests
201+
If instance.RequestRef = RequestRef Then
202+
WebHelpers.LogWarning "Aborting active request: " & instance.nonce, "WebClientAsync.Abort"
203+
instance.Abort Reason
204+
ActiveRequests.Remove instance.nonce
205+
Exit Sub
206+
End If
207+
Next instance
208+
For Each instance In QueuedRequests
209+
If instance.RequestRef = RequestRef Then
210+
WebHelpers.LogWarning "Cancelling queued request: " & instance.nonce, "WebClientAsync.Abort"
211+
QueuedRequests.Remove instance.nonce
212+
Exit Sub
213+
End If
214+
Next instance
215+
216+
Dim errorDescription As String
217+
errorDescription = "Unable to find request to abort"
218+
WebHelpers.LogError errorDescription, "WebClientAsync.Abort", 11081
219+
Err.Raise 11081 + vbObjectError, "WebClientAsync.ExecuteAsync", errorDescription
220+
221+
End Sub
222+
223+
Public Function Exists(Optional ByVal RequestRef As Variant) As Boolean
224+
For Each instance In ActiveRequests
225+
If instance.RequestRef = RequestRef Then
226+
Exists = True
227+
Exit Function
228+
End If
229+
Next instance
230+
For Each instance In QueuedRequests
231+
If instance.RequestRef = RequestRef Then
232+
Exists = True
233+
Exit Function
234+
End If
235+
Next instance
236+
Exists = False
237+
End Function
238+
239+
' --------------------------------------------- '
240+
' Event Handlers
241+
' --------------------------------------------- '
242+
Private Sub WCAI_AsyncError(ByVal nonce As String, ByVal ErrorNumber As Long, ByVal errorDescription As String, ByVal RequestRef As Variant)
243+
WebHelpers.LogDebug "Called", "WebClientAsync.AsyncError"
244+
ActiveRequests.Remove nonce
245+
RaiseEvent AsyncError(ErrorNumber, errorDescription, RequestRef)
246+
Call ExecuteQueuedRequests
247+
End Sub
248+
249+
Private Sub WCAI_AsyncResponse(ByVal nonce As String, ByVal Response As WebResponse, ByVal RequestRef As Variant)
250+
WebHelpers.LogDebug "Called", "WebClientAsync.AsyncResponse"
251+
ActiveRequests.Remove nonce
252+
RaiseEvent AsyncResponse(Response, RequestRef)
253+
End Sub
254+
255+
' --------------------------------------------- '
256+
' Private Subs and Functions
257+
' --------------------------------------------- '
258+
Private Sub ExecuteQueuedRequests()
259+
Dim instance As WebClientAsyncInstance
260+
Do While ActiveRequests.Count < MaxAsyncRequests And QueuedRequests.Count > 0
261+
Set instance = QueuedRequests(1)
262+
QueuedRequests.Remove instance.nonce
263+
ActiveRequests.Add Item:=instance, Key:=instance.nonce
264+
265+
On Error GoTo RequestError
266+
newWCAI.ExecuteAsyncInstance
267+
On Error GoTo 0
268+
Loop
269+
Exit Sub
270+
271+
RequestError:
272+
WebHelpers.LogError "WebClientAsyncInstance error " & Err.Number & ": " & Err.Description, "WebClientAsync.ExecuteAsync"
273+
ActiveRequests.Remove instance.nonce
274+
' Rethrow error
275+
Err.Raise Err.Number, Err.source, Err.Description
276+
End Sub
277+
278+
' --------------------------------------------- '
279+
' Public Properties - Passthrough to WebClient
280+
' --------------------------------------------- '
281+
282+
Public Property Get BaseUrl() As String
283+
BaseUrl = Client.BaseUrl
284+
End Property
285+
Public Property Let BaseUrl(Value As String)
286+
Client.BaseUrl = Value
287+
End Property
288+
289+
Public Property Get Authenticator() As IWebAuthenticator
290+
Set Authenticator = Client.Authenticator
291+
End Property
292+
Public Property Set Authenticator(Value As IWebAuthenticator)
293+
Set Client.Authenticator = Value
294+
End Property
295+
296+
Public Property Get TimeoutMs() As Long
297+
TimeoutMs = Client.TimeoutMs
298+
End Property
299+
Public Property Let TimeoutMs(Value As Long)
300+
Client.TimeoutMs = Value
301+
End Property
302+
303+
Public Property Get ProxyServer() As String
304+
ProxyServer = Client.ProxyServer
305+
End Property
306+
Public Property Let ProxyServer(Value As String)
307+
Client.ProxyServer = Value
308+
End Property
309+
310+
Public Property Get ProxyBypassList() As String
311+
ProxyBypassList = Client.ProxyBypassList
312+
End Property
313+
Public Property Let ProxyBypassList(Value As String)
314+
Client.ProxyBypassList = Value
315+
End Property
316+
317+
Public Property Get ProxyUsername() As String
318+
ProxyUsername = Client.ProxyUsername
319+
End Property
320+
Public Property Let ProxyUsername(Value As String)
321+
Client.ProxyUsername = Value
322+
End Property
323+
324+
Public Property Get ProxyPassword() As String
325+
ProxyPassword = Client.ProxyPassword
326+
End Property
327+
Public Property Let ProxyPassword(Value As String)
328+
Client.ProxyPassword = Value
329+
End Property
330+
331+
Public Property Get EnableAutoProxy() As Boolean
332+
EnableAutoProxy = Client.EnableAutoProxy
333+
End Property
334+
Public Property Let EnableAutoProxy(Value As Boolean)
335+
Client.EnableAutoProxy = Value
336+
End Property
337+
338+
Public Property Get Insecure() As Boolean
339+
Insecure = Client.Insecure
340+
End Property
341+
Public Property Let Insecure(Value As Boolean)
342+
Client.Insecure = Value
343+
End Property
344+
345+
Public Property Get FollowRedirects() As Boolean
346+
FollowRedirects = Client.FollowRedirects
347+
End Property
348+
Public Property Let FollowRedirects(Value As Boolean)
349+
Client.FollowRedirects = Value
350+
End Property
351+
352+
' --------------------------------------------- '
353+
' Public Methods - Passthrough to WebClient
354+
' --------------------------------------------- '
355+
356+
Public Function Execute(Request As WebRequest) As WebResponse
357+
' Although this is intended as an async client,
358+
' the sync execution functions are mapped in order to
359+
' allow the user to choose sync/async at run time.
360+
WebHelpers.LogDebug "WebAsyncRequest.Execute called", "WebClientAsync.Execute"
361+
Execute = Client.Execute(Request)
362+
End Function
363+
364+
Public Function GetJson(Url As String, Optional Options As Dictionary = Nothing) As WebResponse
365+
GetJson = Client.GetJson(Url, Options)
366+
End Function
367+
368+
Public Function PostJson(Url As String, Body As Variant, Optional Options As Dictionary = Nothing) As WebResponse
369+
PostJson = Client.PostJson(Url, Body, Options)
370+
End Function
371+
372+
Public Function GetFullUrl(Request As WebRequest) As String
373+
GetFullUrl = Client.GetFullUrl(Request)
374+
End Function
375+
376+
Public Sub SetProxy( _
377+
Server As String, _
378+
Optional Username As String = "", _
379+
Optional Password As String = "", _
380+
Optional BypassList As String = "")
381+
Client.SetProxy Server, Username, Password, BypassList
382+
End Sub
383+
384+
#End If
385+

0 commit comments

Comments
 (0)