Commit b262cb02 authored by Johannes Metscher's avatar Johannes Metscher

Add new file

parent 7376c9b9
' 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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment