Viele Anforderungen im Takt eines Webdiensts senden

Senden Sie je Zeile einer Tabelle eine Anforderung an einen Webdienst, der 300 Anforderungen pro Minute zulässt. Das Formular bleibt bedienbar, während die Anforderungen laufen, das Ergebnis wird in jede Zeile zurückgeschrieben, und antwortet der Dienst mit 401, melden Sie sich erneut an.

Voraussetzungen: WKL Forms Object Library 1.60 oder höher.

• Eine WklTimerList-Aufgabe der Art wttHttp ist eine Warteschlange. RateLimit = 300 und RateWindow = 60000 begrenzen sie auf 300 Starts pro Minute; Retries wiederholt eine Anforderung, die keine Antwort erhalten hat.
• Requests.Add Method, Url, Body, Tag stellt eine Anforderung in die Warteschlange. Der Tag (hier der Schlüssel der Zeile) kommt in jedem Anforderungsereignis zurück.
• SharedHeader(Name) setzt einen Header, der mit jeder Anforderung gesendet wird, zum Beispiel den API-Schlüssel oder den Sitzungsheader.
• Ereignisse: RequestCompleted bei 2xx und 3xx, RequestFailed bei jeder anderen Antwort (mit dem problem+json-Text in Result.Text) oder bei fehlender Antwort, QueuePaused nach 429, QueueHalted nach 401, TaskCompleted, wenn die Warteschlange leer ist.
• Ein 429 hält die ganze Warteschlange für die in Retry-After angegebene Zeit an und sendet die Anforderung erneut. Ein 401 stoppt sie, bis die Anwendung Resume aufruft; die gestoppte Anforderung wird zuerst gesendet, mit den neuen gemeinsamen Headern.

Ein Formular frmImport enthält eine WklTimerList namens Timer1, eine Schaltfläche cmdSenden und ein Textfeld txtStatus. Die Tabelle tblImport hat die Felder ID (Primärschlüssel), Name, Status (Zahl) und Meldung (Langer Text). Adresse des Diensts und Schlüssel stammen aus Ihren eigenen Einstellungen; schreiben Sie nie einen Schlüssel in den Code.

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 = "Zeile " & 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 = "Zeile " & 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 = "Vom Dienst angehalten bis " & 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 = "Nicht angemeldet; die Anfragen warten."
    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

• Eine andere Antwort als 2xx, 3xx, 401 oder 429 wird nie erneut gesendet, auch kein 5xx: Eine Wiederholung könnte die Arbeit doppelt ausführen. Wiederholt wird nur eine Anforderung ohne Antwort, mit demselben Idempotency-Key.
• Eine Warteschlange je Dienst. Zwei Warteschlangen für denselben Dienst teilen sich ihren Takt nicht. Stellen Sie alle Anforderungen an einen Dienst in eine Warteschlange, zum Beispiel auf dem Shell-Formular.
• Das Schließen des Formulars beendet die Warteschlange: Noch nicht gesendete Anforderungen werden verworfen, danach trifft kein Ereignis mehr ein. Senden Sie sie erneut aus den Zeilen, die noch auf Status = 0 stehen.
• Stop sendet nichts mehr, lässt aber die bereits unterwegs befindliche Anforderung zu Ende laufen und melden.
• Ablaufprotokoll und Fehlertexte enthalten nie Headerwerte oder Inhalte (Bodys); der Schlüssel bleibt im Speicher.

• WklTimerList: alle Regeln der Warteschlange.
• Liste durchsuchen, während der Benutzer tippt