Add new file

vba_sample_client/sample.VBScript

+' Struktur für XML-HTTP-Response (21.06.2017, SRM)
+Public Type tXmlHttpResponse
+Status As String
+ResponseText As String
+ResponseXml As String
+ResponseBody As Variant
+End Type
+
+' Aufruf von XML-HTTP-Request (21.06.2017, SRM)
+Private Function GetXmlHttpResponse(Method As String, _
+URL As String, _
+Async As Boolean, _
+User As String, _
+Password As String, _
+Message As Variant, _
+Optional ContentType As String = "application/json") As tXmlHttpResponse
+Dim oXmlHttp As Object
+
+On Error GoTo Catch
+
+' Microsoft XML HTTP Objekt erzeugen
+Set oXmlHttp = CreateObject("MSXML2.XMLHTTP")
+
+' Sonderzeichen in URL ersetzen
+'    URL = Replace(URL, "Ä", "Ä")
+'    URL = Replace(URL, "ä", "ä")
+'    URL = Replace(URL, "Ö", "Ö")
+'    URL = Replace(URL, "ö", "ö")
+'    URL = Replace(URL, "Ü", "Ü")
+'    URL = Replace(URL, "ü", "ü")
+
+' Umlaute in HEX-Code von UTF8-Zeichentabelle umwandeln
+' Tabelle: siehe http://www.utf8-zeichentabelle.de/
+URL = Replace(URL, "Ä", "%C3%84")
+URL = Replace(URL, "ä", "%C3%A4")
+URL = Replace(URL, "Ö", "%C3%96")
+URL = Replace(URL, "ö", "%C3%B6")
+URL = Replace(URL, "Ü", "%C3%9C")
+URL = Replace(URL, "ü", "%C3%BC")
+
+' Request absetzen
+Call oXmlHttp.Open(Method, URL, Async, User, Password)
+Call oXmlHttp.setRequestHeader("Content-Type", ContentType)
+Call oXmlHttp.setRequestHeader("charset", "UTF-8")
+Call oXmlHttp.setRequestHeader("Authorization", "Basic " & gsEncodeBase64(User & ":" & Password))
+Call oXmlHttp.Send(Message)
+' Rückgabewerte ausgeben
+GetXmlHttpResponse.Status = oXmlHttp.Status
+GetXmlHttpResponse.ResponseText = oXmlHttp.ResponseText
+GetXmlHttpResponse.ResponseXml = oXmlHttp.ResponseXml.Text
+GetXmlHttpResponse.ResponseBody = oXmlHttp.ResponseBody
+
+Catch:
+If Err.Number <> 0 Then
+Call MsgBox(Title:="Fehler beim XML-HTTP-Aufruf", Prompt:=Err.Description, Buttons:=vbExclamation)
+End If
+End Function
\ No newline at end of file