Sample client vbscript (first version)

vba_sample_client/default.asp

+<%@ Language=VBScript %>
+<%
+'/////////////////////////////////////////////////////////////
+'////////////////////   HELPER FUNCTIONS  ////////////////////
+'/////////////////////////////////////////////////////////////
+
+
+'Function is needed for HTTP Authentication
+Function Base64Encode(sText)
+	Dim oXML, oNode
+	
+	Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
+	Set oNode = oXML.CreateElement("base64")
+	oNode.dataType = "bin.base64"
+	oNode.nodeTypedValue =Stream_StringToBinary(sText)
+	Base64Encode = oNode.text
+	Set oNode = Nothing
+	Set oXML = Nothing
+End Function
+
+'Stream_StringToBinary Function
+'2003 Antonin Foller, http://www.motobit.com
+'Text - string parameter To convert To binary data
+Function Stream_StringToBinary(Text)
+	Const adTypeText = 2
+	Const adTypeBinary = 1
+	
+'Create Stream object
+	Dim BinaryStream
+	Set BinaryStream = CreateObject("ADODB.Stream")
+	BinaryStream.Type = adTypeText
+	BinaryStream.CharSet = "us-ascii"
+	BinaryStream.Open
+	BinaryStream.WriteText Text
+	BinaryStream.Position = 0
+	BinaryStream.Type = adTypeBinary
+	BinaryStream.Position = 0
+	Stream_StringToBinary = BinaryStream.Read
+	
+	Set BinaryStream = Nothing
+End Function
+
+'Create Unix Timestamp - Calculate seconds since 01-01-1970
+Function UnixDate(oldDate)
+	UnixDate = DateDiff("s", "01/01/1970 00:00:00", oldDate)
+End Function
+
+'Process host because of encoding of id in url
+'first split it, then encode the relevant string, then create string again with encoded id
+'You can't URLencode the whole string
+Function EncodeHost(sHost)
+    Dim sHostEncoded, hostArr, numberHostArr
+	
+	If (InStr(sHost, "load") > 1) Or (InStr(sHost, "download") > 1) Then
+		sHostEncoded = ""
+		hostArr = Split(sHost, "/")
+		numberHostArr = UBound(hostArr)
+		hostArr(numberHostArr) = Server.URLEncode(hostArr(numberHostArr))
+		For Each x In hostArr
+			sHostEncoded = sHostEncoded & x & "/"
+		Next
+	ELSE
+		sHostEncoded = host
+	End If
+	EncodeHost = sHostEncoded
+End Function
+
+Const adTypeBinary = 1
+Const adTypeText = 2
+
+' accept a string and convert it to Bytes array in the selected Charset
+Function StringToBytes(Str,Charset)
+  Dim Stream : Set Stream = Server.CreateObject("ADODB.Stream")
+  Stream.Type = adTypeText
+  Stream.Charset = Charset
+  Stream.Open
+  Stream.WriteText Str
+  Stream.Flush
+  Stream.Position = 0
+  ' rewind stream and read Bytes
+  Stream.Type = adTypeBinary
+  StringToBytes= Stream.Read
+  Stream.Close
+  Set Stream = Nothing
+End Function
+
+' accept Bytes array and convert it to a string using the selected charset
+Function BytesToString(Bytes, Charset)
+  Dim Stream : Set Stream = Server.CreateObject("ADODB.Stream")
+  Stream.Charset = Charset
+  Stream.Type = adTypeBinary
+  Stream.Open
+  Stream.Write Bytes
+  Stream.Flush
+  Stream.Position = 0
+  ' rewind stream and read text
+  Stream.Type = adTypeText
+  BytesToString= Stream.ReadText
+  Stream.Close
+  Set Stream = Nothing
+End Function
+
+' This will alter charset of a string from 1-byte charset(as windows-1252)
+' to another 1-byte charset(as windows-1251)
+Function AlterCharset(Str, FromCharset, ToCharset)
+  Dim Bytes
+  Bytes = StringToBytes(Str, FromCharset)
+  AlterCharset = BytesToString(Bytes, ToCharset)
+End Function
+
+'/////////////////////////////////////////////////////////////
+'////////////////////   Request FORM      ////////////////////
+'/////////////////////////////////////////////////////////////
+
+
+'Start Error output - for debugging
+'On Error Resume Next
+
+'Set correct encoding for output & input
+Response.Charset  = "utf-8"
+Response.CodePage = 65001
+Session.CodePage  = 65001
+
+'Set global variables
+Dim host, hostEncoded, username, password
+Dim body, header, errors
+'data equals data-form-input
+Dim data, dataEncoded
+Dim HttpReq, query
+Dim newLicenseData
+Dim authKey
+'Create a dictionary for data
+Set newLicenseData = Server.CreateObject("Scripting.Dictionary")
+Set HttpReq        = Server.CreateObject("MSXML2.ServerXMLHTTP")
+
+'Set standard host & user credentials
+host     = "https://bildungsnetz.ghostthinker.de/api/lims/request"
+username = "test"
+password = "test"
+
+host     = "https://bildungsnetz.ghostthinker.de/api/lims/load/DHoB-T-A-0011206"
+username = "DHBAPIUser"
+password = "password"
+
+'Read Form data
+query = Request.Form("data")
+
+If query<>"" Then
+	'When query is available prepare for request sending
+	Dim d, ps
+	'Split query
+	d = Split(query, vbCrLf)
+	
+	'Iterate through variable d - data
+	'Read from data text input field and save it in newLicenseData to send it in request
+	For Each e In d
+		ps = Split(e, "=>")
+		If UBound(ps) = 1 Then
+			If ps(0)<>"" Then
+				newLicenseData.add Trim(ps(0)), Trim(ps(1))
+			End If
+		End If
+	Next
+	
+'Stick the parameter together in to one Dictionary
+Else
+	newLicenseData.add "postal", "42431"
+	newLicenseData.add "organisation_id", ""
+	newLicenseData.add "mail", "test@example.com"
+	newLicenseData.add "training_course_id", ""
+	newLicenseData.add "firstname", "demo"
+	newLicenseData.add "lastname", "user"
+	newLicenseData.add "birthdate", UnixDate(DateAdd("y", -35, Now())) ' Unix timestamp
+	newLicenseData.add "gender", "w"
+	newLicenseData.add "street", "123 Fakestreet"
+	newLicenseData.add "city", "Augsburg"
+	newLicenseData.add "valid_until", UnixDate(DateAdd("y", +5, Now()))
+	newLicenseData.add "issue_date", UnixDate(Now())
+	newLicenseData.add "issue_place", ""
+	newLicenseData.add "honor_code", 1
+	newLicenseData.add "honor_code_date", UnixDate(DateAdd("y", -2, Now()))
+	newLicenseData.add "first_aid", 0
+	newLicenseData.add "first_aid_date", ""
+End If
+
+'Create key=>val schema for textfield
+Dim tmpKeys
+For Each tmpKeys In newLicenseData.Keys
+	data = data & tmpKeys & "=>" & newLicenseData(tmpKeys) & vbCrLf
+Next
+
+'If query is available, get user credentials from form
+If query <> "" Then
+
+	host        = Request.Form("host")
+	username    = Request.Form("username")
+	password    = Request.Form("password")
+	hostEncoded = EncodeHost( host )   
+	
+    'Manually create Basic HTTP Authentication key through Base64 Function
+	authKey     = Base64Encode(username & ":" & password)
+	
+    'Open HTTP request to set all headers, etc. and then send it
+	HttpReq.open "POST", hostEncoded, False
+	
+    'Set all HTTP Headers - except for download
+	HttpReq.setRequestHeader "Accept", "application/json"
+	HttpReq.setRequestHeader "Authorization", "Basic " & authKey
+    
+	'Set to taste in ms
+	HttpReq.setTimeouts 10 * 1000, 10 * 1000, 10 * 1000, 30 * 1000
+	
+    'Iterate through to every key-value to encode variables for post
+	tmpKeys = Null
+	For Each tmpKeys In newLicenseData.Keys
+		dataEncoded = dataEncoded & tmpKeys & "=" & newLicenseData(tmpKeys) & "&"
+	Next
+	
+    'Send request to server
+	HttpReq.send(dataEncoded)
+	
+    'Set Responses in variables to display in HTML
+	header = HttpReq.status & "&nbsp;" & HttpReq.statusText & "<br>" & HttpReq.getAllResponseHeaders
+	body   = HttpReq.responseText
+	errors = err.Description
+	
+    'Set Response Header for correct encoding of displaying data in HTML
+	Response.AddHeader "Content-Type", "text/html;charset=utf-8"
+	
+    'Outlier if download is asked for
+	If InStr(host, "download") Then
+		Response.Buffer = False
+		
+        'Set filetype to pdf
+		'Response.ContentType = "application/pdf"
+		'Response.Charset     = "UTF-8"
+		
+        'Response.AddHeader "Content-Transfer-Encoding", "binary"
+		Response.AddHeader "Pragma", "no-cache"
+		Response.AddHeader "Expires", "0"
+		
+        'Set filename of downloaded attachment
+		Response.AddHeader "Content-Disposition", "attachment; filename=Lizenz.pdf"
+		dim convertedBody
+		convertedBody = AlterCharset(body, "UTF-8" ,"ISO-8859-1")
+		Response.BinaryWrite convertedBody
+		Response.End
+	End If
+	
+'If is no response yet, show some standard text
+Else
+	header = "no response sent yet"
+	body = "no response sent yet"
+	errors = "no response sent yet"
+End If
+
+%>
+<!DOCTYPE html>
+<html>
+<head>
+<title>LiMS ASP Classic</title>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" >
+<style>
+input[type="text"], textarea { width: 500px; }
+label { display: block; }
+</style>
+</head>
+<body>
+<form method="POST" accept-charset="UTF-8">
+  <h1>Request form</h1>
+  <label for="host">Host and service</label>
+  <input type='text' name="host" value="<% response.write(host) %>"/>
+  <label for="username">Username</label>
+  <input type='text' name="username" value="<% response.write(username) %>"/>
+  <label for="password">Password</label>
+  <input type='password' name="password" value="<% response.write(password) %>"/>
+  <label for="data">Data</label>
+  <textarea type='text' name="data" rows="20"><% response.write(data) %></textarea>
+  <br/>
+  <input type="submit" value="send request"/>
+</form>
+
+<h1>Reponse header</h1>
+<pre><% response.write header %></pre>
+<h1>Reponse body</h1>
+<pre><% response.write body %></pre>
+<h1>ASP errors</h1>
+<pre><% response.write err %></pre>
+<h1>Encoding infos</h1>
+<pre>Charset: <% response.write Response.Charset %></pre>
+<pre>CodePage: <% response.write Response.CodePage %></pre>
+
+</body>
+</html>
+