Pošiljanje velikega števila zahtev spletni storitvi v njenem tempu

Za vsako vrstico tabele pošljite po eno zahtevo spletni storitvi, ki dovoljuje 300 zahtev na minuto, obrazec naj ostane uporaben, medtem ko zahteve tečejo, rezultat zapišite nazaj v vsako vrstico in se znova prijavite, ko storitev odgovori s 401.

Zahteva WKL Forms Object Library 1.60 ali novejšo različico.

• Naloga WklTimerList vrste wttHttp je čakalna vrsta. RateLimit = 300 in RateWindow = 60000 jo omejita na 300 začetkov na minuto; Retries ponovi zahtevo, na katero ni bilo odgovora.
• Requests.Add Method, Url, Body, Tag postavi eno zahtevo v čakalno vrsto; Tag (tukaj ključ vrstice) se vrne v vsakem dogodku zahteve.
• SharedHeader(Name) nastavi glavo, ki se pošlje z vsako zahtevo, na primer ključ API ali glavo seje.
• Dogodki: RequestCompleted za 2xx in 3xx, RequestFailed za vsak drug odgovor (z besedilom problem+json v Result.Text) ali če odgovora ni, QueuePaused po 429, QueueHalted po 401, TaskCompleted, ko je čakalna vrsta prazna.
• Odgovor 429 začasno ustavi celotno čakalno vrsto za čas iz Retry-After in zahtevo pošlje znova. Odgovor 401 jo zaustavi, dokler aplikacija ne pokliče Resume; zaustavljena zahteva se pošlje prva, z novimi skupnimi glavami.

Obrazec frmImport s kontrolnikom WklTimerList z imenom Timer1, gumbom cmdSenden in poljem z besedilom txtStatus. Tabela tblImport ima polja ID (primarni ključ), Name, Status (število) in Meldung (dolgo besedilo). Naslov storitve in ključ prihajata iz vaših lastnih nastavitev; ključa nikoli ne zapišite v kodo.

Option Compare Database
Option Explicit
 
Private Const ServiceUrl As String = "https://service.example.com/api/persons"
 
Private Sub Form_Load()
    Dim q As Object
    On Error GoTo ErrorHandler
 
    If Me!Timer1.Object.Tasks.Count = 0 Then
        Set q = Me!Timer1.Object.Tasks.Add("import", wttHttp)
        q.RateLimit = 300
        q.RateWindow = 60000
        q.Retries = 2
        q.RetryDelay = 1000
    End If
 
FinalHandler:
    Set q = Nothing
    Exit Sub
 
ErrorHandler:
    MsgBox Err.Description, vbExclamation
    Resume FinalHandler
End Sub
 
Private Sub cmdSenden_Click()
    Dim rs As DAO.Recordset, q As Object
    On Error GoTo ErrorHandler
 
    Set q = Me!Timer1.Object.Tasks("import")
    q.SharedHeader("X-Api-Key") = ApiKey()   ' your own function, for example from a protected setting
    Set rs = CurrentDb.OpenRecordset("SELECT ID, Name FROM tblImport WHERE Status = 0", dbOpenSnapshot)
    Do Until rs.EOF
        q.Requests.Add "POST", ServiceUrl, "{""name"":""" & Replace(rs!Name, """", "\""") & """}", rs!ID
        rs.MoveNext
    Loop
    q.Start
    Me!txtStatus = q.Requests.Waiting & " requests waiting"
 
FinalHandler:
    If Not rs Is Nothing Then rs.Close
    Set rs = Nothing
    Set q = Nothing
    Exit Sub
 
ErrorHandler:
    MsgBox Err.Description, vbExclamation
    Resume FinalHandler
End Sub
 
Private Sub Timer1_RequestCompleted(ByVal Key As String, ByVal Id As Long, ByVal Tag As Variant, ByVal Status As Long, ByVal Result As Object)
    On Error GoTo ErrorHandler
 
    CurrentDb.Execute "UPDATE tblImport SET Status = " & Status & ", Meldung = Null WHERE ID = " & Tag, dbFailOnError
 
FinalHandler:
    Exit Sub
 
ErrorHandler:
    Me!txtStatus = "Vrstica " & Tag & ": " & Err.Description
    Resume FinalHandler
End Sub
 
Private Sub Timer1_RequestFailed(ByVal Key As String, ByVal Id As Long, ByVal Tag As Variant, ByVal Status As Long, ByVal Description As String, ByVal WillRetry As Boolean, ByVal Result As Object)
    Dim text As String
    On Error GoTo ErrorHandler
 
    If WillRetry Then GoTo FinalHandler          ' the queue sends it again
    text = Description
    If Not Result Is Nothing Then text = Result.Text   ' for example the problem+json message of a 422
    CurrentDb.Execute "UPDATE tblImport SET Status = " & Status & ", Meldung = '" & Replace(text, "'", "''") & "' WHERE ID = " & Tag, dbFailOnError
 
FinalHandler:
    Exit Sub
 
ErrorHandler:
    Me!txtStatus = "Vrstica " & Tag & ": " & Err.Description
    Resume FinalHandler
End Sub
 
Private Sub Timer1_QueuePaused(ByVal Key As String, ByVal Reason As String, ByVal ResumeAt As Date)
    Me!txtStatus = "Storitev je pošiljanje ustavila do " & Format(ResumeAt, "hh:nn:ss")
End Sub
 
Private Sub Timer1_QueueHalted(ByVal Key As String, ByVal Id As Long, ByVal Status As Long, ByVal Headers As String)
    On Error GoTo ErrorHandler
 
    ' 401: sign in again on the main thread, set the new header, go on with the halted request.
    If SignIn() Then   ' your own sign-in form; returns the new session in gSession
        Me!Timer1.Object.Tasks("import").SharedHeader("Wkl-Session") = gSession
        Me!Timer1.Object.Tasks("import").Resume
    Else
        Me!txtStatus = "Niste prijavljeni; zahteve čakajo."
    End If
 
FinalHandler:
    Exit Sub
 
ErrorHandler:
    Me!txtStatus = Err.Description
    Resume FinalHandler
End Sub
 
Private Sub Timer1_TaskCompleted(ByVal Key As String, ByVal RunId As Long, ByVal Result As Variant)
    Me!txtStatus = Result(0) & " sent, " & Result(1) & " failed"
End Sub

• Odgovor, ki ni 2xx, 3xx, 401 ali 429, se nikoli ne pošlje znova, tudi 5xx ne: ponovitev bi lahko isto delo opravila dvakrat. Ponovi se le zahteva brez odgovora, z istim Idempotency-Key.
• Ena čakalna vrsta na storitev. Dve čakalni vrsti za isto storitev si tempa ne delita; vse zahteve za eno storitev postavite v eno čakalno vrsto, na primer na obrazcu lupine.
• Zaprtje obrazca konča čakalno vrsto: še neposlane zahteve se zavržejo, noben dogodek ne prispe več. Znova jih pošljite iz vrstic, ki imajo še Status = 0.
• Stop ne pošlje ničesar več, zahtevi, ki je že na poti, pa pusti, da se konča in sporoči rezultat.
• Sled in besedila napak nikoli ne vsebujejo vrednosti glav ali teles; ključ ostane v pomnilniku.

• WklTimerList: vsa pravila čakalne vrste.
• Iskanje po seznamu med tipkanjem